From gitlab at gitlab.haskell.org Wed Mar 1 00:26:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 28 Feb 2023 19:26:37 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Take more care with unlifted bindings in the specialiser Message-ID: <63fe9bbd5a4e6_2100188a871242035a4@gitlab.mail> 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# = + 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: From gitlab at gitlab.haskell.org Wed Mar 1 06:37:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Mar 2023 01:37:22 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: hadrian: Add dependency from lib/settings to mk/config.mk Message-ID: <63fef2a2e3173_210018e7bd8e82332a4@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2b7a96cc by Ben Gamari at 2023-03-01T01:37:12-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. - - - - - 5c22c053 by Sebastian Graf at 2023-03-01T01:37:13-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - 7be1029c by Simon Peyton Jones at 2023-03-01T01:37:13-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - ae30c8a9 by romes at 2023-03-01T01:37:14-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 14 changed files: - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Tc/TyCl/Utils.hs - hadrian/bindist/Makefile - libraries/base/GHC/List.hs - + testsuite/tests/patsyn/should_compile/T23038.hs - + testsuite/tests/patsyn/should_compile/T23038.stderr - testsuite/tests/patsyn/should_compile/all.T - testsuite/tests/perf/should_run/T18964.hs - + testsuite/tests/perf/should_run/T23021.hs - + testsuite/tests/perf/should_run/T23021.stdout - testsuite/tests/perf/should_run/all.T - + testsuite/tests/th/T23036.hs - + testsuite/tests/th/T23036.stderr - testsuite/tests/th/all.T Changes: ===================================== 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') } ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -903,19 +903,30 @@ mkOneRecordSelector all_cons idDetails fl has_sel con1 = assert (not (null cons_w_field)) $ head cons_w_field -- Selector type; Note [Polymorphic selectors] - field_ty = conLikeFieldType con1 lbl - data_tv_set = tyCoVarsOfTypes (data_ty : req_theta) - data_tvbs = filter (\tvb -> binderVar tvb `elemVarSet` data_tv_set) $ - conLikeUserTyVarBinders con1 + (univ_tvs, _, _, _, req_theta, _, data_ty) = conLikeFullSig con1 + + field_ty = conLikeFieldType con1 lbl + field_ty_tvs = tyCoVarsOfType field_ty + data_ty_tvs = tyCoVarsOfType data_ty + sel_tvs = field_ty_tvs `unionVarSet` data_ty_tvs + sel_tvbs = filter (\tvb -> binderVar tvb `elemVarSet` sel_tvs) $ + conLikeUserTyVarBinders con1 -- is_naughty: see Note [Naughty record selectors] - is_naughty = not (tyCoVarsOfType field_ty `subVarSet` data_tv_set) - || has_sel == NoFieldSelectors -- No field selectors => all are naughty - -- thus suppressing making a binding - -- A slight hack! + is_naughty = not ok_scoping || no_selectors + ok_scoping = case con1 of + RealDataCon {} -> field_ty_tvs `subVarSet` data_ty_tvs + PatSynCon {} -> field_ty_tvs `subVarSet` mkVarSet univ_tvs + -- In the PatSynCon case, the selector type is (data_ty -> field_ty), but + -- fvs(data_ty) are all universals (see Note [Pattern synonym result type] in + -- GHC.Core.PatSyn, so no need to check them. + + no_selectors = has_sel == NoFieldSelectors -- No field selectors => all are naughty + -- thus suppressing making a binding + -- A slight hack! sel_ty | is_naughty = unitTy -- See Note [Naughty record selectors] - | otherwise = mkForAllTys (tyVarSpecToBinders data_tvbs) $ + | otherwise = mkForAllTys (tyVarSpecToBinders sel_tvbs) $ -- Urgh! See Note [The stupid context] in GHC.Core.DataCon mkPhiTy (conLikeStupidTheta con1) $ -- req_theta is empty for normal DataCon @@ -926,7 +937,7 @@ mkOneRecordSelector all_cons idDetails fl has_sel -- fields in all the constructor have multiplicity Many. field_ty - -- Make the binding: sel (C2 { fld = x }) = x + -- make the binding: sel (C2 { fld = x }) = x -- sel (C7 { fld = x }) = x -- where cons_w_field = [C2,C7] sel_bind = mkTopFunBind Generated sel_lname alts @@ -976,8 +987,6 @@ mkOneRecordSelector all_cons idDetails fl has_sel where inst_tys = dataConResRepTyArgs dc - (_, _, _, _, req_theta, _, data_ty) = conLikeFullSig con1 - unit_rhs = mkLHsTupleExpr [] noExtField msg_lit = HsStringPrim NoSourceText (bytesFS (field_label lbl)) @@ -1036,36 +1045,42 @@ so that if the user tries to use 'x' as a selector we can bleat helpfully, rather than saying unhelpfully that 'x' is not in scope. Hence the sel_naughty flag, to identify record selectors that don't really exist. -In general, a field is "naughty" if its type mentions a type variable that -isn't in - * the (original, user-written) result type of the constructor, or - * the "required theta" for the constructor - -Note that this *allows* GADT record selectors (Note [GADT record -selectors]) whose types may look like sel :: T [a] -> a - -The "required theta" part is illustrated by test patsyn/should_run/records_run -where we have - - pattern ReadP :: Read a => a -> String - pattern ReadP {readp} <- (read -> readp) - -The selector is defined like this: - - $selreadp :: ReadP a => String -> a - $selReadP s = readp s - -Perfectly fine! The (ReadP a) constraint lets us contructor a value -of type 'a' from a bare String. NB: "required theta" is empty for -data cons (see conLikeFullSig), so this reasoning only bites for -patttern synonyms. - For naughty selectors we make a dummy binding sel = () so that the later type-check will add them to the environment, and they'll be exported. The function is never called, because the typechecker spots the sel_naughty field. +To determine naughtiness we distingish two cases: + +* For RealDataCons, a field is "naughty" if its type mentions a + type variable that isn't in the (original, user-written) result type + of the constructor. Note that this *allows* GADT record selectors + (Note [GADT record selectors]) whose types may look like sel :: T [a] -> a + +* For a PatSynCon, a field is "naughty" if its type mentions a type variable + that isn't in the universal type variables. + + This is a bit subtle. Consider test patsyn/should_run/records_run: + pattern ReadP :: forall a. ReadP a => a -> String + pattern ReadP {fld} <- (read -> readp) + The selector is defined like this: + $selReadPfld :: forall a. ReadP a => String -> a + $selReadPfld @a (d::ReadP a) s = readp @a d s + Perfectly fine! The (ReadP a) constraint lets us contruct a value of type + 'a' from a bare String. + + Another curious case (#23038): + pattern N :: forall a. () => forall. () => a -> Any + pattern N { fld } <- ( unsafeCoerce -> fld1 ) where N = unsafeCoerce + The selector looks like this + $selNfld :: forall a. Any -> a + $selNfld @a x = unsafeCoerce @Any @a x + Pretty strange (but used in the `cleff` package). + + TL;DR for pattern synonyms, the selector is OK if the field type mentions only + the universal type variables of the pattern synonym. + Note [NoFieldSelectors and naughty record selectors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Under NoFieldSelectors (see Note [NoFieldSelectors] in GHC.Rename.Env), record ===================================== 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)")' >> $@ ===================================== libraries/base/GHC/List.hs ===================================== @@ -886,23 +886,12 @@ takeWhileFB p c n = \x r -> if p x then x `c` r else n -- [] -- >>> dropWhile (< 0) [1,2,3] -- [1,2,3] -{-# NOINLINE [1] dropWhile #-} dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile _ [] = [] dropWhile p xs@(x:xs') | p x = dropWhile p xs' | otherwise = xs -{-# INLINE [0] dropWhileFB #-} -- See Note [Inline FB functions] -dropWhileFB :: (a -> Bool) -> (a -> b -> b) -> b -> a -> (Bool -> b) -> Bool -> b -dropWhileFB p c _n x xs = \drp -> if drp && p x then xs True else x `c` xs False - -{-# RULES -"dropWhile" [~1] forall p xs. dropWhile p xs = - build (\c n -> foldr (dropWhileFB p c n) (flipSeq n) xs True) -"dropWhileList" [1] forall p xs. foldr (dropWhileFB p (:) []) (flipSeq []) xs True = dropWhile p xs - #-} - -- | 'take' @n@, applied to a list @xs@, returns the prefix of @xs@ -- of length @n@, or @xs@ itself if @n >= 'length' xs at . -- @@ -998,31 +987,17 @@ drop n xs | n <= 0 = xs drop _ [] = [] drop n (_:xs) = drop (n-1) xs #else /* hack away */ -{-# INLINE[1] drop #-} -- Why [1]? See justification on take! => RULES +{-# INLINE drop #-} drop n ls | n <= 0 = ls | otherwise = unsafeDrop n ls - --- A version of drop that drops the whole list if given an argument --- less than 1 -{-# NOINLINE [0] unsafeDrop #-} -- See Note [Inline FB functions] -unsafeDrop :: Int -> [a] -> [a] -unsafeDrop !_ [] = [] -unsafeDrop 1 (_:xs) = xs -unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs - -{-# RULES -"drop" [~1] forall n xs . drop n xs = - build (\c nil -> if n <= 0 - then foldr c nil xs - else foldr (dropFB c nil) (flipSeq nil) xs n) -"unsafeDropList" [1] forall n xs . foldr (dropFB (:) []) (flipSeq []) xs n - = unsafeDrop n xs - #-} - -{-# INLINE [0] dropFB #-} -- See Note [Inline FB functions] -dropFB :: (a -> b -> b) -> b -> a -> (Int -> b) -> Int -> b -dropFB c _n x xs = \ m -> if m <= 0 then x `c` xs m else xs (m-1) + where + -- A version of drop that drops the whole list if given an argument + -- less than 1 + unsafeDrop :: Int -> [a] -> [a] + unsafeDrop !_ [] = [] + unsafeDrop 1 (_:xs) = xs + unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs #endif -- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of ===================================== testsuite/tests/patsyn/should_compile/T23038.hs ===================================== @@ -0,0 +1,19 @@ +{-# LANGUAGE PatternSynonyms, ViewPatterns, ScopedTypeVariables #-} + +module T23038 where + +import GHC.Types( Any ) +import Unsafe.Coerce( unsafeCoerce ) + +pattern N1 :: forall a. () => forall. () => a -> Any +pattern N1 { fld1 } <- ( unsafeCoerce -> fld1 ) + where N1 = unsafeCoerce + +pattern N2 :: forall. () => forall a. () => a -> Any +pattern N2 { fld2 } <- ( unsafeCoerce -> fld2 ) + where N2 = unsafeCoerce + +test1, test2 :: forall a. Any -> a + +test1 = fld1 -- Should be OK +test2 = fld2 -- Should be rejected ===================================== testsuite/tests/patsyn/should_compile/T23038.stderr ===================================== @@ -0,0 +1,6 @@ + +T23038.hs:19:9: error: [GHC-55876] + • Cannot use record selector ‘fld2’ as a function due to escaped type variables + • In the expression: fld2 + In an equation for ‘test2’: test2 = fld2 + Suggested fix: Use pattern-matching syntax instead ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -83,3 +83,4 @@ test('T17775-singleton', normal, compile, ['']) test('T14630', normal, compile, ['-Wname-shadowing']) test('T21531', [ grep_errmsg(r'INLINE') ], compile, ['-ddump-ds']) test('T22521', normal, compile, ['']) +test('T23038', normal, compile_fail, ['']) ===================================== testsuite/tests/perf/should_run/T18964.hs ===================================== @@ -3,6 +3,9 @@ import Data.Int main :: IO () main = do + -- This test aims to track #18964, the fix of which had to be reverted in the + -- wake of #23021. The comments below apply to a world where #18964 is fixed. + -------------------- -- drop should fuse away and the program should consume O(1) space -- If fusion fails, this allocates about 640MB. print $ sum $ drop 10 [0..10000000::Int64] ===================================== testsuite/tests/perf/should_run/T23021.hs ===================================== @@ -0,0 +1,30 @@ +-- The direct implementation of drop and dropWhile operates in O(1) space. +-- This regression test asserts that potential fusion rules for dropWhile/drop +-- maintain that property for the fused pipelines in dropWhile2 and drop2 (which +-- are marked NOINLINE for that purpose). +-- #23021 was opened because we had fusion rules in place that did not maintain +-- this property. + +dropWhile2 :: Int -> [Int] -> [Int] +dropWhile2 n = dropWhile (< n) . dropWhile (< n) +{-# NOINLINE dropWhile2 #-} + +drop2 :: Int -> [Int] -> [Int] +drop2 n = drop n . drop n +{-# NOINLINE drop2 #-} + +main :: IO () +main = do + let xs = [0..9999999] + print $ last $ dropWhile2 0 xs + print $ last $ dropWhile2 1 xs + print $ last $ dropWhile2 2 xs + print $ last $ dropWhile2 3 xs + print $ last $ dropWhile2 4 xs + print $ last $ dropWhile2 5 xs + print $ last $ drop2 0 xs + print $ last $ drop2 1 xs + print $ last $ drop2 2 xs + print $ last $ drop2 3 xs + print $ last $ drop2 4 xs + print $ last $ drop2 5 xs ===================================== testsuite/tests/perf/should_run/T23021.stdout ===================================== @@ -0,0 +1,12 @@ +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -411,4 +411,7 @@ test('T21839r', compile_and_run, ['-O']) +# #18964 should be marked expect_broken, but it's still useful to track that +# perf doesn't regress further, so it is not marked as such. test('T18964', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O']) +test('T23021', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O2']) ===================================== 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']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8140c68fb2cbe994f9723e9adc9658b216fcb74...ae30c8a98791d7254bf3c15b979add63ec56e585 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8140c68fb2cbe994f9723e9adc9658b216fcb74...ae30c8a98791d7254bf3c15b979add63ec56e585 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 1 09:17:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Mar 2023 04:17:36 -0500 Subject: [Git][ghc/ghc][master] hadrian: Add dependency from lib/settings to mk/config.mk Message-ID: <63ff1830208a8_210018112227782603f2@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - 1 changed file: - hadrian/bindist/Makefile Changes: ===================================== 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)")' >> $@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/79ffa170a6b0b152da0e02744869311773733286 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/79ffa170a6b0b152da0e02744869311773733286 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 1 09:18:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Mar 2023 04:18:11 -0500 Subject: [Git][ghc/ghc][master] Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" Message-ID: <63ff1853ab132_2100181110a9d02639f2@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - 5 changed files: - libraries/base/GHC/List.hs - testsuite/tests/perf/should_run/T18964.hs - + testsuite/tests/perf/should_run/T23021.hs - + testsuite/tests/perf/should_run/T23021.stdout - testsuite/tests/perf/should_run/all.T Changes: ===================================== libraries/base/GHC/List.hs ===================================== @@ -886,23 +886,12 @@ takeWhileFB p c n = \x r -> if p x then x `c` r else n -- [] -- >>> dropWhile (< 0) [1,2,3] -- [1,2,3] -{-# NOINLINE [1] dropWhile #-} dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile _ [] = [] dropWhile p xs@(x:xs') | p x = dropWhile p xs' | otherwise = xs -{-# INLINE [0] dropWhileFB #-} -- See Note [Inline FB functions] -dropWhileFB :: (a -> Bool) -> (a -> b -> b) -> b -> a -> (Bool -> b) -> Bool -> b -dropWhileFB p c _n x xs = \drp -> if drp && p x then xs True else x `c` xs False - -{-# RULES -"dropWhile" [~1] forall p xs. dropWhile p xs = - build (\c n -> foldr (dropWhileFB p c n) (flipSeq n) xs True) -"dropWhileList" [1] forall p xs. foldr (dropWhileFB p (:) []) (flipSeq []) xs True = dropWhile p xs - #-} - -- | 'take' @n@, applied to a list @xs@, returns the prefix of @xs@ -- of length @n@, or @xs@ itself if @n >= 'length' xs at . -- @@ -998,31 +987,17 @@ drop n xs | n <= 0 = xs drop _ [] = [] drop n (_:xs) = drop (n-1) xs #else /* hack away */ -{-# INLINE[1] drop #-} -- Why [1]? See justification on take! => RULES +{-# INLINE drop #-} drop n ls | n <= 0 = ls | otherwise = unsafeDrop n ls - --- A version of drop that drops the whole list if given an argument --- less than 1 -{-# NOINLINE [0] unsafeDrop #-} -- See Note [Inline FB functions] -unsafeDrop :: Int -> [a] -> [a] -unsafeDrop !_ [] = [] -unsafeDrop 1 (_:xs) = xs -unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs - -{-# RULES -"drop" [~1] forall n xs . drop n xs = - build (\c nil -> if n <= 0 - then foldr c nil xs - else foldr (dropFB c nil) (flipSeq nil) xs n) -"unsafeDropList" [1] forall n xs . foldr (dropFB (:) []) (flipSeq []) xs n - = unsafeDrop n xs - #-} - -{-# INLINE [0] dropFB #-} -- See Note [Inline FB functions] -dropFB :: (a -> b -> b) -> b -> a -> (Int -> b) -> Int -> b -dropFB c _n x xs = \ m -> if m <= 0 then x `c` xs m else xs (m-1) + where + -- A version of drop that drops the whole list if given an argument + -- less than 1 + unsafeDrop :: Int -> [a] -> [a] + unsafeDrop !_ [] = [] + unsafeDrop 1 (_:xs) = xs + unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs #endif -- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of ===================================== testsuite/tests/perf/should_run/T18964.hs ===================================== @@ -3,6 +3,9 @@ import Data.Int main :: IO () main = do + -- This test aims to track #18964, the fix of which had to be reverted in the + -- wake of #23021. The comments below apply to a world where #18964 is fixed. + -------------------- -- drop should fuse away and the program should consume O(1) space -- If fusion fails, this allocates about 640MB. print $ sum $ drop 10 [0..10000000::Int64] ===================================== testsuite/tests/perf/should_run/T23021.hs ===================================== @@ -0,0 +1,30 @@ +-- The direct implementation of drop and dropWhile operates in O(1) space. +-- This regression test asserts that potential fusion rules for dropWhile/drop +-- maintain that property for the fused pipelines in dropWhile2 and drop2 (which +-- are marked NOINLINE for that purpose). +-- #23021 was opened because we had fusion rules in place that did not maintain +-- this property. + +dropWhile2 :: Int -> [Int] -> [Int] +dropWhile2 n = dropWhile (< n) . dropWhile (< n) +{-# NOINLINE dropWhile2 #-} + +drop2 :: Int -> [Int] -> [Int] +drop2 n = drop n . drop n +{-# NOINLINE drop2 #-} + +main :: IO () +main = do + let xs = [0..9999999] + print $ last $ dropWhile2 0 xs + print $ last $ dropWhile2 1 xs + print $ last $ dropWhile2 2 xs + print $ last $ dropWhile2 3 xs + print $ last $ dropWhile2 4 xs + print $ last $ dropWhile2 5 xs + print $ last $ drop2 0 xs + print $ last $ drop2 1 xs + print $ last $ drop2 2 xs + print $ last $ drop2 3 xs + print $ last $ drop2 4 xs + print $ last $ drop2 5 xs ===================================== testsuite/tests/perf/should_run/T23021.stdout ===================================== @@ -0,0 +1,12 @@ +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -411,4 +411,7 @@ test('T21839r', compile_and_run, ['-O']) +# #18964 should be marked expect_broken, but it's still useful to track that +# perf doesn't regress further, so it is not marked as such. test('T18964', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O']) +test('T23021', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O2']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2a1a1c08bb520b74b00194a83add82b287b38d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2a1a1c08bb520b74b00194a83add82b287b38d5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 1 09:18:52 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Mar 2023 04:18:52 -0500 Subject: [Git][ghc/ghc][master] Refine the test for naughty record selectors Message-ID: <63ff187c121d2_210018113c75382710fe@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 4 changed files: - compiler/GHC/Tc/TyCl/Utils.hs - + testsuite/tests/patsyn/should_compile/T23038.hs - + testsuite/tests/patsyn/should_compile/T23038.stderr - testsuite/tests/patsyn/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -903,19 +903,30 @@ mkOneRecordSelector all_cons idDetails fl has_sel con1 = assert (not (null cons_w_field)) $ head cons_w_field -- Selector type; Note [Polymorphic selectors] - field_ty = conLikeFieldType con1 lbl - data_tv_set = tyCoVarsOfTypes (data_ty : req_theta) - data_tvbs = filter (\tvb -> binderVar tvb `elemVarSet` data_tv_set) $ - conLikeUserTyVarBinders con1 + (univ_tvs, _, _, _, req_theta, _, data_ty) = conLikeFullSig con1 + + field_ty = conLikeFieldType con1 lbl + field_ty_tvs = tyCoVarsOfType field_ty + data_ty_tvs = tyCoVarsOfType data_ty + sel_tvs = field_ty_tvs `unionVarSet` data_ty_tvs + sel_tvbs = filter (\tvb -> binderVar tvb `elemVarSet` sel_tvs) $ + conLikeUserTyVarBinders con1 -- is_naughty: see Note [Naughty record selectors] - is_naughty = not (tyCoVarsOfType field_ty `subVarSet` data_tv_set) - || has_sel == NoFieldSelectors -- No field selectors => all are naughty - -- thus suppressing making a binding - -- A slight hack! + is_naughty = not ok_scoping || no_selectors + ok_scoping = case con1 of + RealDataCon {} -> field_ty_tvs `subVarSet` data_ty_tvs + PatSynCon {} -> field_ty_tvs `subVarSet` mkVarSet univ_tvs + -- In the PatSynCon case, the selector type is (data_ty -> field_ty), but + -- fvs(data_ty) are all universals (see Note [Pattern synonym result type] in + -- GHC.Core.PatSyn, so no need to check them. + + no_selectors = has_sel == NoFieldSelectors -- No field selectors => all are naughty + -- thus suppressing making a binding + -- A slight hack! sel_ty | is_naughty = unitTy -- See Note [Naughty record selectors] - | otherwise = mkForAllTys (tyVarSpecToBinders data_tvbs) $ + | otherwise = mkForAllTys (tyVarSpecToBinders sel_tvbs) $ -- Urgh! See Note [The stupid context] in GHC.Core.DataCon mkPhiTy (conLikeStupidTheta con1) $ -- req_theta is empty for normal DataCon @@ -926,7 +937,7 @@ mkOneRecordSelector all_cons idDetails fl has_sel -- fields in all the constructor have multiplicity Many. field_ty - -- Make the binding: sel (C2 { fld = x }) = x + -- make the binding: sel (C2 { fld = x }) = x -- sel (C7 { fld = x }) = x -- where cons_w_field = [C2,C7] sel_bind = mkTopFunBind Generated sel_lname alts @@ -976,8 +987,6 @@ mkOneRecordSelector all_cons idDetails fl has_sel where inst_tys = dataConResRepTyArgs dc - (_, _, _, _, req_theta, _, data_ty) = conLikeFullSig con1 - unit_rhs = mkLHsTupleExpr [] noExtField msg_lit = HsStringPrim NoSourceText (bytesFS (field_label lbl)) @@ -1036,36 +1045,42 @@ so that if the user tries to use 'x' as a selector we can bleat helpfully, rather than saying unhelpfully that 'x' is not in scope. Hence the sel_naughty flag, to identify record selectors that don't really exist. -In general, a field is "naughty" if its type mentions a type variable that -isn't in - * the (original, user-written) result type of the constructor, or - * the "required theta" for the constructor - -Note that this *allows* GADT record selectors (Note [GADT record -selectors]) whose types may look like sel :: T [a] -> a - -The "required theta" part is illustrated by test patsyn/should_run/records_run -where we have - - pattern ReadP :: Read a => a -> String - pattern ReadP {readp} <- (read -> readp) - -The selector is defined like this: - - $selreadp :: ReadP a => String -> a - $selReadP s = readp s - -Perfectly fine! The (ReadP a) constraint lets us contructor a value -of type 'a' from a bare String. NB: "required theta" is empty for -data cons (see conLikeFullSig), so this reasoning only bites for -patttern synonyms. - For naughty selectors we make a dummy binding sel = () so that the later type-check will add them to the environment, and they'll be exported. The function is never called, because the typechecker spots the sel_naughty field. +To determine naughtiness we distingish two cases: + +* For RealDataCons, a field is "naughty" if its type mentions a + type variable that isn't in the (original, user-written) result type + of the constructor. Note that this *allows* GADT record selectors + (Note [GADT record selectors]) whose types may look like sel :: T [a] -> a + +* For a PatSynCon, a field is "naughty" if its type mentions a type variable + that isn't in the universal type variables. + + This is a bit subtle. Consider test patsyn/should_run/records_run: + pattern ReadP :: forall a. ReadP a => a -> String + pattern ReadP {fld} <- (read -> readp) + The selector is defined like this: + $selReadPfld :: forall a. ReadP a => String -> a + $selReadPfld @a (d::ReadP a) s = readp @a d s + Perfectly fine! The (ReadP a) constraint lets us contruct a value of type + 'a' from a bare String. + + Another curious case (#23038): + pattern N :: forall a. () => forall. () => a -> Any + pattern N { fld } <- ( unsafeCoerce -> fld1 ) where N = unsafeCoerce + The selector looks like this + $selNfld :: forall a. Any -> a + $selNfld @a x = unsafeCoerce @Any @a x + Pretty strange (but used in the `cleff` package). + + TL;DR for pattern synonyms, the selector is OK if the field type mentions only + the universal type variables of the pattern synonym. + Note [NoFieldSelectors and naughty record selectors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Under NoFieldSelectors (see Note [NoFieldSelectors] in GHC.Rename.Env), record ===================================== testsuite/tests/patsyn/should_compile/T23038.hs ===================================== @@ -0,0 +1,19 @@ +{-# LANGUAGE PatternSynonyms, ViewPatterns, ScopedTypeVariables #-} + +module T23038 where + +import GHC.Types( Any ) +import Unsafe.Coerce( unsafeCoerce ) + +pattern N1 :: forall a. () => forall. () => a -> Any +pattern N1 { fld1 } <- ( unsafeCoerce -> fld1 ) + where N1 = unsafeCoerce + +pattern N2 :: forall. () => forall a. () => a -> Any +pattern N2 { fld2 } <- ( unsafeCoerce -> fld2 ) + where N2 = unsafeCoerce + +test1, test2 :: forall a. Any -> a + +test1 = fld1 -- Should be OK +test2 = fld2 -- Should be rejected ===================================== testsuite/tests/patsyn/should_compile/T23038.stderr ===================================== @@ -0,0 +1,6 @@ + +T23038.hs:19:9: error: [GHC-55876] + • Cannot use record selector ‘fld2’ as a function due to escaped type variables + • In the expression: fld2 + In an equation for ‘test2’: test2 = fld2 + Suggested fix: Use pattern-matching syntax instead ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -83,3 +83,4 @@ test('T17775-singleton', normal, compile, ['']) test('T14630', normal, compile, ['-Wname-shadowing']) test('T21531', [ grep_errmsg(r'INLINE') ], compile, ['-ddump-ds']) test('T22521', normal, compile, ['']) +test('T23038', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf118e2fac04b79cc7fa63cff0552190c3885bb9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf118e2fac04b79cc7fa63cff0552190c3885bb9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 1 09:19:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 01 Mar 2023 04:19:29 -0500 Subject: [Git][ghc/ghc][master] fix: Consider strictness annotation in rep_bind Message-ID: <63ff18a16b007_21001810f9ba5427664@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 4 changed files: - compiler/GHC/HsToCore/Quote.hs - + testsuite/tests/th/T23036.hs - + testsuite/tests/th/T23036.stderr - testsuite/tests/th/all.T Changes: ===================================== 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') } ===================================== 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']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86f240ca956f633c20a61872ec44de9e21266624 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86f240ca956f633c20a61872ec44de9e21266624 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 1 14:40:56 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 01 Mar 2023 09:40:56 -0500 Subject: [Git][ghc/ghc][wip/t21766] Detect darwin for `--enable-static-libzstd` Message-ID: <63ff63f8c397d_21001816924e683312d3@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: d0d27379 by Finley McIlwaine at 2023-03-01T07:38:58-07:00 Detect darwin for `--enable-static-libzstd` Update users guide to note the optional static linking of libzstd, and update ci-images rev to get libzstd in debian images on CI - - - - - 4 changed files: - .gitlab-ci.yml - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - m4/fp_find_libzstd.m4 Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 572353e0644044fe3a5465bba4342a9a0b0eb60e + DOCKER_REV: 6fc51b534f2e955b5e5f8e48eefe5d5c2cd84c05 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -32,11 +32,15 @@ Compiler `here` for directions) and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` script. **Note**: This feature requires that the machine building GHC has - `libzstd `_ installed. + `libzstd `_ installed. The compression + library `libzstd` may optionally be statically linked in the resulting + compiler (on non-darwin machines) using the `--enable-static-libzstd` + configure flag. In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` enabled build results was reduced by over 20% when compression was enabled. + - Incoherent instance applications are no longer specialised. The previous implementation of specialisation resulted in nondeterministic instance resolution in certain cases, breaking the specification described in the documentation of the `INCOHERENT` pragma. See GHC ticket ===================================== docs/users_guide/debug-info.rst ===================================== @@ -380,10 +380,13 @@ to a source location. This lookup table is generated by using the ``-finfo-table binaries, consider building GHC from source and supplying the ``--enable-ipe-data-compression`` flag to the ``configure`` script. This will cause GHC to compress the :ghc-flag:`-finfo-table-map` related - debugging information included in binaries using the `libzstd - `_ compression library. **Note**: This - feature requires that the machine building GHC has - `libzstd `_ installed. + debugging information included in binaries using the + `libzstd `_ compression library. + **Note**: This feature requires that the machine building GHC has + `libzstd `_ installed. The compression + library ``libzstd`` may optionally be statically linked in the resulting + compiler (on non-darwin machines) using the ``--enable-static-libzstd`` + configure flag. In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` enabled build results was reduced by over 20% when compression was enabled. ===================================== m4/fp_find_libzstd.m4 ===================================== @@ -19,7 +19,7 @@ AC_DEFUN([FP_FIND_LIBZSTD], [AS_HELP_STRING( [--enable-static-libzstd], [Statically link the libzstd compression library with the compiler - [default=no]] + (not compatible with darwin) [default=no]] )], [StaticLibZstd=1], [StaticLibZstd=0] @@ -89,6 +89,12 @@ AC_DEFUN([FP_FIND_LIBZSTD], AC_SUBST([UseLibZstd],[YES]) AC_SUBST([CabalHaveLibZstd],[True]) if test $StaticLibZstd = "1" ; then + case "${host_os}" in + darwin*) + AC_MSG_ERROR( + [--enable-static-libzstd is not compatible with darwin] + ) + esac AC_SUBST([UseStaticLibZstd],[YES]) AC_SUBST([CabalStaticLibZstd],[True]) else View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d0d273796d6a28bc819e8cb61a89dd1ec0592b52 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d0d273796d6a28bc819e8cb61a89dd1ec0592b52 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 1 14:42:51 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 01 Mar 2023 09:42:51 -0500 Subject: [Git][ghc/ghc][wip/t21766] 19 commits: Take more care with unlifted bindings in the specialiser Message-ID: <63ff646b2f2fb_210018169e9dbc3318ac@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 64f5e711 by Finley McIlwaine at 2023-03-01T07:42:40-07:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 8d776741 by Finley McIlwaine at 2023-03-01T07:42:40-07:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - 340f5c3f by Finley McIlwaine at 2023-03-01T07:42:40-07:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - a192b1a5 by Finley McIlwaine at 2023-03-01T07:42:40-07:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 3118dfb4 by Finley McIlwaine at 2023-03-01T07:42:40-07:00 Add note describing IPE data compression See ticket #21766 - - - - - a9b7b0f1 by Finley McIlwaine at 2023-03-01T07:42:40-07:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 7c215d4f by Finley McIlwaine at 2023-03-01T07:42:40-07:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - d27a722a by Finley McIlwaine at 2023-03-01T07:42:40-07:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - c601cda2 by Finley McIlwaine at 2023-03-01T07:42:40-07:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - bacfc601 by Finley McIlwaine at 2023-03-01T07:42:40-07:00 Update user's guide and release notes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. See ticket #21766 - - - - - 92ffe242 by Finley McIlwaine at 2023-03-01T07:42:40-07:00 Fix multiline string in `IPE.c` - - - - - e8ffbc9b by Finley McIlwaine at 2023-03-01T07:42:40-07:00 Optional static linking of libzstd Allow for libzstd to be statically linked with a `--enable-static-libzstd` configure flag. Not supported on darwin due to incompatibility with `:x.a` linker flags. - - - - - 67a13bd2 by Finley McIlwaine at 2023-03-01T07:42:40-07:00 Detect darwin for `--enable-static-libzstd` Update users guide to note the optional static linking of libzstd, and update ci-images rev to get libzstd in debian images on CI - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - 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 - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/GHC/List.hs - m4/fp_find_libnuma.m4 - + m4/fp_find_libzstd.m4 - rts/IPE.c - rts/IPE.h - rts/include/rts/IPE.h - rts/rts.cabal.in - + testsuite/tests/patsyn/should_compile/T23038.hs - + testsuite/tests/patsyn/should_compile/T23038.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d0d273796d6a28bc819e8cb61a89dd1ec0592b52...67a13bd2102fe79c849e713707bc62c84c73288f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d0d273796d6a28bc819e8cb61a89dd1ec0592b52...67a13bd2102fe79c849e713707bc62c84c73288f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 1 17:05:04 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 01 Mar 2023 12:05:04 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/test-llvm-hdoc Message-ID: <63ff85c04768f_210018190df868347639@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/test-llvm-hdoc at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/test-llvm-hdoc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 1 18:03:15 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 01 Mar 2023 13:03:15 -0500 Subject: [Git][ghc/ghc][wip/T21909] 7 commits: Take more care with unlifted bindings in the specialiser Message-ID: <63ff936381bb9_21001819eb2e5435236@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - f89fefc5 by Apoorv Ingle at 2023-03-01T12:03:01-06:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [SimplifyInfer and UndecidableSuperClasses] - - - - - 30 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/Driver/Session.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Constraint.hs - docs/users_guide/expected-undocumented-flags.txt - hadrian/bindist/Makefile - libraries/base/GHC/List.hs - + testsuite/tests/patsyn/should_compile/T23038.hs - + testsuite/tests/patsyn/should_compile/T23038.stderr - testsuite/tests/patsyn/should_compile/all.T - testsuite/tests/perf/should_run/T18964.hs - + testsuite/tests/perf/should_run/T23021.hs - + testsuite/tests/perf/should_run/T23021.stdout - testsuite/tests/perf/should_run/all.T - + 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/T21909.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42dac9ef24ff1f7486ddae3c6429b2ca7c2802ae...f89fefc53ff33f9d478889552bbdbc2bd6fb5b3a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42dac9ef24ff1f7486ddae3c6429b2ca7c2802ae...f89fefc53ff33f9d478889552bbdbc2bd6fb5b3a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 11:29:58 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 02 Mar 2023 06:29:58 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22023 Message-ID: <640088b655a1b_2100182a58ddcc4224c9@gitlab.mail> Simon Peyton Jones pushed new branch wip/T22023 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22023 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 12:40:01 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Thu, 02 Mar 2023 07:40:01 -0500 Subject: [Git][ghc/ghc][wip/T20749] Make DataCon workers strict in strict fields (#20749) Message-ID: <64009921f2c91_2100182baddc68452171@gitlab.mail> Sebastian Graf pushed to branch wip/T20749 at Glasgow Haskell Compiler / GHC Commits: 90383d3b by Sebastian Graf at 2023-03-02T13:39:45+01:00 Make DataCon workers strict in strict fields (#20749) This patch tweaks `exprIsConApp_maybe`, `exprIsHNF` and frieds, and Demand Analysis so that they exploit and maintain strictness of DataCon workers. See `Note [Strict fields in Core]` for details. Very little needed to change, and it puts field seq insertion done by Tag Inference into a new perspective: That of *implementing* strict field semantics. Before Tag Inference, DataCon workers are strict. Afterwards they are effectively lazy and field seqs happen around use sites. History has shown that there is no other way to guarantee taggedness and thus the STG Strict Field Invariant. Unfortunately, T21392 does no longer reproduce after this patch, so I marked it as "not broken" in order to track whether we regress again in the future. Fixes #20749, the satisfying conclusion of an annoying saga (cf. the ideas in #21497 and #22475). - - - - - 19 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Misc.hs - testsuite/tests/simplCore/should_compile/T18013.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -615,6 +615,8 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri -- See Note [Constructor tag allocation] and #14657 data_con = mkDataCon dc_name declared_infix prom_info (map (const no_bang) arg_tys) + (map (const HsLazy) arg_tys) + (map (const NotMarkedStrict) arg_tys) [] -- No labelled fields tyvars ex_tyvars (mkTyVarBinders SpecifiedSpec user_tyvars) ===================================== compiler/GHC/Core.hs ===================================== @@ -42,7 +42,7 @@ module GHC.Core ( foldBindersOfBindStrict, foldBindersOfBindsStrict, collectBinders, collectTyBinders, collectTyAndValBinders, collectNBinders, collectNValBinders_maybe, - collectArgs, stripNArgs, collectArgsTicks, flattenBinds, + collectArgs, collectValArgs, stripNArgs, collectArgsTicks, flattenBinds, collectFunSimple, exprToType, @@ -983,6 +983,60 @@ tail position: A cast changes the type, but the type must be the same. But operationally, casts are vacuous, so this is a bit unfortunate! See #14610 for ideas how to fix this. +Note [Strict fields in Core] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Evaluating a data constructor worker evaluates its strict fields. + +In other words, if `MkT` is strict in its first field and `xs` reduces to +`error "boom"`, then `MkT xs b` will throw that error. +Conversely, it is sound to seq the field before the call to the constructor, +e.g., with `case xs of xs' { __DEFAULT -> MkT xs' b }`. +Let's call this transformation "field seq insertion". + +Note in particular that the data constructor application `MkT xs b` above is +*not* a value, unless `xs` is! + +This has pervasive effect on the Core pipeline: + + * `exprIsHNF`/`exprIsConLike`/`exprOkForSpeculation` need to assert that the + strict arguments of a DataCon worker are values/ok-for-spec themselves. + + * `exprIsConApp_maybe` inserts field seqs in the `FloatBind`s it returns, so + that the Simplifier, Constant-folding, the pattern-match checker, etc. + all see the insert field seqs when they match on strict workers. Often this + is just to emphasise strict semantics, but for case-of-known constructor + and case-to-let field insertion is *vital*, otherwise these transformations + would lose field seqs. + + * The demand signature of a data constructor is strict in strict field + position, whereas is it's normally lazy. Likewise the demand *transformer* + of a DataCon worker can add stricten up demands on strict field args. + See Note [Demand transformer for data constructors]. + + * In the absence of `-fpedantic-bottoms`, it is still possible that some seqs + are ultimately dropped or delayed due to eta-expansion. + See Note [Dealing with Bottom]. + +Strict field semantics is exploited in STG by Note [Tag inference]: +It performs field seq insertion to statically guarantee *taggedness* of strict +fields, establishing the Note [STG Strict Field Invariant]. (Happily, most +of those seqs are immediately detected as redundant by tag inference and are +omitted.) From then on, DataCon worker semantics are actually lazy, hence it is +important that STG passes maintain the Strict Field Invariant. + + +Historical Note: +The delightfully simple description of strict field semantics is the result of +a long saga (#20749, the bits about strict data constructors in #21497, #22475), +where we tried a more lenient (but actually not) semantics first that would +allow both strict and lazy implementations of DataCon workers. This was favoured +because the "pervasive effect" throughout the compiler was deemed too large +(when it really turned out to be very modest). +Alas, this semantics would require us to implement `exprIsHNF` in *exactly* the +same way as above, otherwise the analysis would not be conservative wrt. the +lenient semantics (which includes the strict one). It is also much harder to +explain and maintain, as it turned out. + ************************************************************************ * * In/Out type synonyms @@ -2043,6 +2097,17 @@ collectArgs expr go (App f a) as = go f (a:as) go e as = (e, as) +-- | Takes a nested application expression and returns the function +-- being applied and the arguments to which it is applied +collectValArgs :: Expr b -> (Expr b, [Arg b]) +collectValArgs expr + = go expr [] + where + go (App f a) as + | isValArg a = go f (a:as) + | otherwise = go f as + go e as = (e, as) + -- | Takes a nested application expression and returns the function -- being applied. Looking through casts and ticks to find it. collectFunSimple :: Expr b -> Expr b ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -48,7 +48,8 @@ module GHC.Core.DataCon ( dataConIsInfix, dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitTyThings, - dataConRepStrictness, dataConImplBangs, dataConBoxer, + dataConRepStrictness, dataConRepStrictness_maybe, + dataConImplBangs, dataConBoxer, splitDataProductType_maybe, @@ -59,7 +60,7 @@ module GHC.Core.DataCon ( isVanillaDataCon, isNewDataCon, isTypeDataCon, classDataCon, dataConCannotMatch, dataConUserTyVarsNeedWrapper, checkDataConTyVars, - isBanged, isMarkedStrict, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked, + isBanged, isUnpacked, isMarkedStrict, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked, specialPromotedDc, -- ** Promotion related functions @@ -95,6 +96,7 @@ import GHC.Types.Unique.FM ( UniqFM ) import GHC.Types.Unique.Set import GHC.Builtin.Uniques( mkAlphaTyVarUnique ) import GHC.Data.Graph.UnVar -- UnVarSet and operations +import GHC.Data.Maybe (orElse) import GHC.Utils.Outputable import GHC.Utils.Misc @@ -501,6 +503,18 @@ data DataCon -- Matches 1-1 with dcOrigArgTys -- Hence length = dataConSourceArity dataCon + dcImplBangs :: [HsImplBang], + -- The actual decisions made (including failures) + -- about the original arguments; 1-1 with orig_arg_tys + -- See Note [Bangs on data constructor arguments] + + dcStricts :: [StrictnessMark], + -- One mark for every field of the DataCon worker; + -- if it's empty, then all fields are lazy, + -- otherwise it has the same length as dataConRepArgTys. + -- See also Note [Strict fields in Core] in GHC.Core + -- for the effect on the strictness signature + dcFields :: [FieldLabel], -- Field labels for this constructor, in the -- same order as the dcOrigArgTys; @@ -776,13 +790,6 @@ data DataConRep -- after unboxing and flattening, -- and *including* all evidence args - , dcr_stricts :: [StrictnessMark] -- 1-1 with dcr_arg_tys - -- See also Note [Data-con worker strictness] - - , dcr_bangs :: [HsImplBang] -- The actual decisions made (including failures) - -- about the original arguments; 1-1 with orig_arg_tys - -- See Note [Bangs on data constructor arguments] - } type DataConEnv a = UniqFM DataCon a -- Keyed by DataCon @@ -851,43 +858,8 @@ eqSpecPreds spec = [ mkPrimEqPred (mkTyVarTy tv) ty instance Outputable EqSpec where ppr (EqSpec tv ty) = ppr (tv, ty) -{- Note [Data-con worker strictness] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Notice that we do *not* say the worker Id is strict even if the data -constructor is declared strict - e.g. data T = MkT ![Int] Bool -Even though most often the evals are done by the *wrapper* $WMkT, there are -situations in which tag inference will re-insert evals around the worker. -So for all intents and purposes the *worker* MkT is strict, too! - -Unfortunately, if we exposed accurate strictness of DataCon workers, we'd -see the following transformation: - - f xs = case xs of xs' { __DEFAULT -> ... case MkT xs b of x { __DEFAULT -> [x] } } -- DmdAnal: Strict in xs - ==> { drop-seq, binder swap on xs' } - f xs = case MkT xs b of x { __DEFAULT -> [x] } -- DmdAnal: Still strict in xs - ==> { case-to-let } - f xs = let x = MkT xs' b in [x] -- DmdAnal: No longer strict in xs! - -I.e., we are ironically losing strictness in `xs` by dropping the eval on `xs` -and then doing case-to-let. The issue is that `exprIsHNF` currently says that -every DataCon worker app is a value. The implicit assumption is that surrounding -evals will have evaluated strict fields like `xs` before! But now that we had -just dropped the eval on `xs`, that assumption is no longer valid. - -Long story short: By keeping the demand signature lazy, the Simplifier will not -drop the eval on `xs` and using `exprIsHNF` to decide case-to-let and others -remains sound. - -Similarly, during demand analysis in dmdTransformDataConSig, we bump up the -field demand with `C_01`, *not* `C_11`, because the latter exposes too much -strictness that will drop the eval on `xs` above. - -This issue is discussed at length in -"Failed idea: no wrappers for strict data constructors" in #21497 and #22475. - -Note [Bangs on data constructor arguments] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Bangs on data constructor arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data T = MkT !Int {-# UNPACK #-} !Int Bool @@ -913,8 +885,8 @@ Terminology: the flag settings in the importing module. Also see Note [Bangs on imported data constructors] in GHC.Types.Id.Make -* The dcr_bangs field of the dcRep field records the [HsImplBang] - If T was defined in this module, Without -O the dcr_bangs might be +* The dcImplBangs field records the [HsImplBang] + If T was defined in this module, Without -O the dcImplBangs might be [HsStrict _, HsStrict _, HsLazy] With -O it might be [HsStrict _, HsUnpack _, HsLazy] @@ -958,6 +930,17 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. +* Core passes will often need to know whether the DataCon worker or wrapper in + an application is strict in some (lifted) field or not. This is tracked in the + demand signature attached to a DataCon's worker resp. wrapper Id. + + So if you've got a DataCon dc, you can get the demand signature by + `idDmdSig (dataConWorkId dc)` and make out strict args by testing with + `isStrictDmd`. Similarly, `idDmdSig <$> dataConWrapId_maybe dc` gives + you the demand signature of the wrapper, if it exists. + + These demand signatures are set in GHC.Types.Id.Make. + Note [Data con representation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The dcRepType field contains the type of the representation of a constructor @@ -973,14 +956,14 @@ what it means is the DataCon with all Unpacking having been applied. We can think of this as the Core representation. Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# + data Ord a => T a = MkT !Int a Void# Here T :: Ord a => Int -> a -> Void# -> T a but the rep type is Trep :: Int# -> a -> Void# -> T a Actually, the unboxed part isn't implemented yet! -Not that this representation is still *different* from runtime +Note that this representation is still *different* from runtime representation. (Which is what STG uses after unarise). This is how T would end up being used in STG post-unarise: @@ -1105,6 +1088,11 @@ isBanged (HsUnpack {}) = True isBanged (HsStrict {}) = True isBanged HsLazy = False +isUnpacked :: HsImplBang -> Bool +isUnpacked (HsUnpack {}) = True +isUnpacked (HsStrict {}) = False +isUnpacked HsLazy = False + isSrcStrict :: SrcStrictness -> Bool isSrcStrict SrcStrict = True isSrcStrict _ = False @@ -1130,13 +1118,15 @@ cbvFromStrictMark MarkedStrict = MarkedCbv -- | Build a new data constructor mkDataCon :: Name - -> Bool -- ^ Is the constructor declared infix? - -> TyConRepName -- ^ TyConRepName for the promoted TyCon - -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user - -> [FieldLabel] -- ^ Field labels for the constructor, - -- if it is a record, otherwise empty - -> [TyVar] -- ^ Universals. - -> [TyCoVar] -- ^ Existentials. + -> Bool -- ^ Is the constructor declared infix? + -> TyConRepName -- ^ TyConRepName for the promoted TyCon + -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user + -> [HsImplBang] -- ^ Strictness/unpack annotations, as inferred by the compiler + -> [StrictnessMark] -- ^ Strictness marks for the DataCon worker's fields in Core + -> [FieldLabel] -- ^ Field labels for the constructor, + -- if it is a record, otherwise empty + -> [TyVar] -- ^ Universals. + -> [TyCoVar] -- ^ Existentials. -> [InvisTVBinder] -- ^ User-written 'TyVarBinder's. -- These must be Inferred/Specified. -- See @Note [TyVarBinders in DataCons]@ @@ -1155,7 +1145,9 @@ mkDataCon :: Name -- Can get the tag from the TyCon mkDataCon name declared_infix prom_info - arg_stricts -- Must match orig_arg_tys 1-1 + arg_stricts -- Must match orig_arg_tys 1-1 + impl_bangs -- Must match orig_arg_tys 1-1 + str_marks -- Must be empty or match dataConRepArgTys 1-1 fields univ_tvs ex_tvs user_tvbs eq_spec theta @@ -1172,6 +1164,8 @@ mkDataCon name declared_infix prom_info = con where is_vanilla = null ex_tvs && null eq_spec && null theta + str_marks' | not $ any isMarkedStrict str_marks = [] + | otherwise = str_marks con = MkData {dcName = name, dcUnique = nameUnique name, dcVanilla = is_vanilla, dcInfix = declared_infix, @@ -1183,7 +1177,8 @@ mkDataCon name declared_infix prom_info dcStupidTheta = stupid_theta, dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty, dcRepTyCon = rep_tycon, - dcSrcBangs = arg_stricts, + dcSrcBangs = arg_stricts, dcImplBangs = impl_bangs, + dcStricts = str_marks', dcFields = fields, dcTag = tag, dcRepType = rep_ty, dcWorkId = work_id, dcRep = rep, @@ -1411,19 +1406,27 @@ isNullaryRepDataCon :: DataCon -> Bool isNullaryRepDataCon dc = dataConRepArity dc == 0 dataConRepStrictness :: DataCon -> [StrictnessMark] --- ^ Give the demands on the arguments of a --- Core constructor application (Con dc args) -dataConRepStrictness dc = case dcRep dc of - NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc] - DCR { dcr_stricts = strs } -> strs +-- ^ Give the demands on the runtime arguments of a Core DataCon worker +-- application. +-- The length of the list matches `dataConRepArgTys` (e.g., the number +-- of runtime arguments). +dataConRepStrictness dc + = dataConRepStrictness_maybe dc + `orElse` map (const NotMarkedStrict) (dataConRepArgTys dc) + +dataConRepStrictness_maybe :: DataCon -> Maybe [StrictnessMark] +-- ^ Give the demands on the runtime arguments of a Core DataCon worker +-- application or `Nothing` if all of them are lazy. +-- The length of the list matches `dataConRepArgTys` (e.g., the number +-- of runtime arguments). +dataConRepStrictness_maybe dc + | null (dcStricts dc) = Nothing + | otherwise = Just (dcStricts dc) dataConImplBangs :: DataCon -> [HsImplBang] -- The implementation decisions about the strictness/unpack of each -- source program argument to the data constructor -dataConImplBangs dc - = case dcRep dc of - NoDataConRep -> replicate (dcSourceArity dc) HsLazy - DCR { dcr_bangs = bangs } -> bangs +dataConImplBangs dc = dcImplBangs dc dataConBoxer :: DataCon -> Maybe DataConBoxer dataConBoxer (MkData { dcRep = DCR { dcr_boxer = boxer } }) = Just boxer ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -1461,7 +1461,7 @@ myExprIsCheap (AE { am_opts = opts, am_sigs = sigs }) e mb_ty -- See Note [Eta expanding through dictionaries] -- See Note [Eta expanding through CallStacks] - cheap_fun e = exprIsCheapX (myIsCheapApp sigs) e + cheap_fun e = exprIsCheapX (myIsCheapApp sigs) False e -- | A version of 'isCheapApp' that considers results from arity analysis. -- See Note [Arity analysis] for what's in the signature environment and why ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -46,7 +46,7 @@ import GHC.Core import GHC.Core.Make import GHC.Core.SimpleOpt ( exprIsConApp_maybe, exprIsLiteral_maybe ) import GHC.Core.DataCon ( DataCon,dataConTagZ, dataConTyCon, dataConWrapId, dataConWorkId ) -import GHC.Core.Utils ( cheapEqExpr, exprIsHNF +import GHC.Core.Utils ( cheapEqExpr, exprOkForSpeculation , stripTicksTop, stripTicksTopT, mkTicks ) import GHC.Core.Multiplicity import GHC.Core.Rules.Config @@ -1936,7 +1936,7 @@ Things to note Implementing seq#. The compiler has magic for SeqOp in -- GHC.Core.Opt.ConstantFold.seqRule: eliminate (seq# s) +- GHC.Core.Opt.ConstantFold.seqRule: eliminate (seq# s) - GHC.StgToCmm.Expr.cgExpr, and cgCase: special case for seq# @@ -1951,7 +1951,7 @@ Implementing seq#. The compiler has magic for SeqOp in seqRule :: RuleM CoreExpr seqRule = do [Type _ty_a, Type _ty_s, a, s] <- getArgs - guard $ exprIsHNF a + guard $ exprOkForSpeculation a return $ mkCoreUnboxedTuple [s, a] -- spark# :: forall a s . a -> State# s -> (# State# s, a #) ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -814,6 +814,10 @@ to the Divergence lattice, but in practice it turned out to be hard to untaint from 'topDiv' to 'conDiv', leading to bugs, performance regressions and complexity that didn't justify the single fixed testcase T13380c. +You might think that we should check for side-effects rather than just for +precise exceptions. Right you are! See Note [Side-effects and strictness] +for why we unfortunately do not. + Note [Demand analysis for recursive data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ T11545 features a single-product, recursive data type ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -8,14 +8,13 @@ module GHC.Core.Opt.Simplify.Env ( -- * The simplifier mode - SimplMode(..), updMode, - smPedanticBottoms, smPlatform, + SimplMode(..), updMode, smPlatform, -- * Environments SimplEnv(..), pprSimplEnv, -- Temp not abstract seArityOpts, seCaseCase, seCaseFolding, seCaseMerge, seCastSwizzle, seDoEtaReduction, seEtaExpand, seFloatEnable, seInline, seNames, - seOptCoercionOpts, sePedanticBottoms, sePhase, sePlatform, sePreInline, + seOptCoercionOpts, sePhase, sePlatform, sePreInline, seRuleOpts, seRules, seUnfoldingOpts, mkSimplEnv, extendIdSubst, extendTvSubst, extendCvSubst, @@ -216,9 +215,6 @@ seNames env = sm_names (seMode env) seOptCoercionOpts :: SimplEnv -> OptCoercionOpts seOptCoercionOpts env = sm_co_opt_opts (seMode env) -sePedanticBottoms :: SimplEnv -> Bool -sePedanticBottoms env = smPedanticBottoms (seMode env) - sePhase :: SimplEnv -> CompilerPhase sePhase env = sm_phase (seMode env) @@ -276,9 +272,6 @@ instance Outputable SimplMode where where pp_flag f s = ppUnless f (text "no") <+> s -smPedanticBottoms :: SimplMode -> Bool -smPedanticBottoms opts = ao_ped_bot (sm_arity_opts opts) - smPlatform :: SimplMode -> Platform smPlatform opts = roPlatform (sm_rule_opts opts) ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2063,8 +2063,8 @@ For applications of a data constructor worker, the full glory of rebuildCall is a waste of effort; * They never inline, obviously * They have no rewrite rules -* They are not strict (see Note [Data-con worker strictness] - in GHC.Core.DataCon) +* Though they might be strict (see Note [Strict fields in Core] in GHC.Core), + we will exploit that strictness through their demand signature So it's fine to zoom straight to `rebuild` which just rebuilds the call in a very straightforward way. @@ -3273,7 +3273,7 @@ a case pattern. This is *important*. Consider We really must record that b is already evaluated so that we don't go and re-evaluate it when constructing the result. -See Note [Data-con worker strictness] in GHC.Core.DataCon +See Note [Strict fields in Core] in GHC.Core. NB: simplLamBndrs preserves this eval info ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -1219,11 +1219,8 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr -- simplifier produces rhs[exp/a], changing semantics if exp is not ok-for-spec -- Good: returning (Mk#, [x]) with a float of case exp of x { DEFAULT -> [] } -- simplifier produces case exp of a { DEFAULT -> exp[x/a] } - = let arg' = subst_expr subst arg - bndr = uniqAway (subst_in_scope subst) (mkWildValBinder ManyTy arg_type) - float = FloatCase arg' bndr DEFAULT [] - subst' = subst_extend_in_scope subst bndr - in go subst' (float:floats) fun (CC (Var bndr : args) co) + , (subst', float, bndr) <- case_bind subst arg arg_type + = go subst' (float:floats) fun (CC (Var bndr : args) co) | otherwise = go subst floats fun (CC (subst_expr subst arg : args) co) @@ -1262,8 +1259,9 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr | Just con <- isDataConWorkId_maybe fun , count isValArg args == idArity fun - = succeedWith in_scope floats $ - pushCoDataCon con args co + , (in_scope', seq_floats, args') <- mkFieldSeqFloats in_scope con args + = succeedWith in_scope' (seq_floats ++ floats) $ + pushCoDataCon con args' co -- Look through data constructor wrappers: they inline late (See Note -- [Activation for data constructor wrappers]) but we want to do @@ -1349,6 +1347,36 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr extend (Left in_scope) v e = Right (extendSubst (mkEmptySubst in_scope) v e) extend (Right s) v e = Right (extendSubst s v e) + case_bind :: Either InScopeSet Subst -> CoreExpr -> Type -> (Either InScopeSet Subst, FloatBind, Id) + case_bind subst expr expr_ty = (subst', float, bndr) + where + bndr = setCaseBndrEvald MarkedStrict $ + uniqAway (subst_in_scope subst) $ + mkWildValBinder ManyTy expr_ty + subst' = subst_extend_in_scope subst bndr + expr' = subst_expr subst expr + float = FloatCase expr' bndr DEFAULT [] + + mkFieldSeqFloats :: InScopeSet -> DataCon -> [CoreExpr] -> (InScopeSet, [FloatBind], [CoreExpr]) + mkFieldSeqFloats in_scope dc args + | Nothing <- dataConRepStrictness_maybe dc + = (in_scope, [], args) + | otherwise + = (in_scope', floats', ty_args ++ val_args') + where + (ty_args, val_args) = splitAtList (dataConUnivAndExTyCoVars dc) args + (in_scope', floats', val_args') = foldr do_one (in_scope, [], []) $ zipEqual "mkFieldSeqFloats" str_marks val_args + str_marks = dataConRepStrictness dc + do_one (str, arg) (in_scope,floats,args) + | NotMarkedStrict <- str = (in_scope, floats, arg:args) + | Var v <- arg, is_evald v = (in_scope, floats, arg:args) + | otherwise = (in_scope', float:floats, Var bndr:args) + where + is_evald v = isId v && isEvaldUnfolding (idUnfolding v) + (in_scope', float, bndr) = + case case_bind (Left in_scope) arg (exprType arg) of + (Left in_scope', float, bndr) -> (in_scope', float, bndr) + (right, _, _) -> pprPanic "case_bind did not preserve Left" (ppr in_scope $$ ppr arg $$ ppr right) -- See Note [exprIsConApp_maybe on literal strings] dealWithStringLiteral :: Var -> BS.ByteString -> Coercion ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1220,18 +1220,23 @@ in this (which it previously was): in \w. v True -} --------------------- -exprIsWorkFree :: CoreExpr -> Bool -- See Note [exprIsWorkFree] -exprIsWorkFree e = exprIsCheapX isWorkFreeApp e - -exprIsCheap :: CoreExpr -> Bool -exprIsCheap e = exprIsCheapX isCheapApp e +------------------------------------- +type CheapAppFun = Id -> Arity -> Bool + -- Is an application of this function to n *value* args + -- always cheap, assuming the arguments are cheap? + -- True mainly of data constructors, partial applications; + -- but with minor variations: + -- isWorkFreeApp + -- isCheapApp + -- isExpandableApp -exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool +exprIsCheapX :: CheapAppFun -> Bool -> CoreExpr -> Bool {-# INLINE exprIsCheapX #-} --- allow specialization of exprIsCheap and exprIsWorkFree +-- allow specialization of exprIsCheap, exprIsWorkFree and exprIsExpandable -- instead of having an unknown call to ok_app -exprIsCheapX ok_app e +-- expandable: Only True for exprIsExpandable, where Case and Let are never +-- expandable. +exprIsCheapX ok_app expandable e = ok e where ok e = go 0 e @@ -1242,98 +1247,34 @@ exprIsCheapX ok_app e go _ (Type {}) = True go _ (Coercion {}) = True go n (Cast e _) = go n e - go n (Case scrut _ _ alts) = ok scrut && - and [ go n rhs | Alt _ _ rhs <- alts ] go n (Tick t e) | tickishCounts t = False | otherwise = go n e go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e | otherwise = go n e go n (App f e) | isRuntimeArg e = go (n+1) f && ok e | otherwise = go n f - go n (Let (NonRec _ r) e) = go n e && ok r - go n (Let (Rec prs) e) = go n e && all (ok . snd) prs + go n (Case scrut _ _ alts) = not expandable && ok scrut && + and [ go n rhs | Alt _ _ rhs <- alts ] + go n (Let (NonRec _ r) e) = not expandable && go n e && ok r + go n (Let (Rec prs) e) = not expandable && go n e && all (ok . snd) prs -- Case: see Note [Case expressions are work-free] -- App, Let: see Note [Arguments and let-bindings exprIsCheapX] +-------------------- +exprIsWorkFree :: CoreExpr -> Bool +-- See Note [exprIsWorkFree] +exprIsWorkFree e = exprIsCheapX isWorkFreeApp False e -{- Note [exprIsExpandable] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -An expression is "expandable" if we are willing to duplicate it, if doing -so might make a RULE or case-of-constructor fire. Consider - let x = (a,b) - y = build g - in ....(case x of (p,q) -> rhs)....(foldr k z y).... - -We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold), -but we do want - - * the case-expression to simplify - (via exprIsConApp_maybe, exprIsLiteral_maybe) - - * the foldr/build RULE to fire - (by expanding the unfolding during rule matching) - -So we classify the unfolding of a let-binding as "expandable" (via the -uf_expandable field) if we want to do this kind of on-the-fly -expansion. Specifically: - -* True of constructor applications (K a b) - -* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic. - (NB: exprIsCheap might not be true of this) - -* False of case-expressions. If we have - let x = case ... in ...(case x of ...)... - we won't simplify. We have to inline x. See #14688. - -* False of let-expressions (same reason); and in any case we - float lets out of an RHS if doing so will reveal an expandable - application (see SimplEnv.doFloatFromRhs). - -* Take care: exprIsExpandable should /not/ be true of primops. I - found this in test T5623a: - let q = /\a. Ptr a (a +# b) - in case q @ Float of Ptr v -> ...q... - - q's inlining should not be expandable, else exprIsConApp_maybe will - say that (q @ Float) expands to (Ptr a (a +# b)), and that will - duplicate the (a +# b) primop, which we should not do lightly. - (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) --} +-------------------- +exprIsCheap :: CoreExpr -> Bool +-- See Note [exprIsCheap] +exprIsCheap e = exprIsCheapX isCheapApp False e -------------------------------------- +-------------------- exprIsExpandable :: CoreExpr -> Bool -- See Note [exprIsExpandable] -exprIsExpandable e - = ok e - where - ok e = go 0 e - - -- n is the number of value arguments - go n (Var v) = isExpandableApp v n - go _ (Lit {}) = True - go _ (Type {}) = True - go _ (Coercion {}) = True - go n (Cast e _) = go n e - go n (Tick t e) | tickishCounts t = False - | otherwise = go n e - go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e - | otherwise = go n e - go n (App f e) | isRuntimeArg e = go (n+1) f && ok e - | otherwise = go n f - go _ (Case {}) = False - go _ (Let {}) = False - - -------------------------------------- -type CheapAppFun = Id -> Arity -> Bool - -- Is an application of this function to n *value* args - -- always cheap, assuming the arguments are cheap? - -- True mainly of data constructors, partial applications; - -- but with minor variations: - -- isWorkFreeApp - -- isCheapApp +exprIsExpandable e = exprIsCheapX isExpandableApp True e isWorkFreeApp :: CheapAppFun isWorkFreeApp fn n_val_args @@ -1352,7 +1293,7 @@ isCheapApp fn n_val_args | isDeadEndId fn = True -- See Note [isCheapApp: bottoming functions] | otherwise = case idDetails fn of - DataConWorkId {} -> True -- Actually handled by isWorkFreeApp + -- DataConWorkId {} -> _ -- Handled by isWorkFreeApp RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId op _ -> primOpIsCheap op @@ -1367,6 +1308,7 @@ isExpandableApp fn n_val_args | isWorkFreeApp fn n_val_args = True | otherwise = case idDetails fn of + -- DataConWorkId {} -> _ -- Handled by isWorkFreeApp RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId {} -> False @@ -1398,6 +1340,50 @@ isExpandableApp fn n_val_args I'm not sure why we have a special case for bottoming functions in isCheapApp. Maybe we don't need it. +Note [exprIsExpandable] +~~~~~~~~~~~~~~~~~~~~~~~ +An expression is "expandable" if we are willing to duplicate it, if doing +so might make a RULE or case-of-constructor fire. Consider + let x = (a,b) + y = build g + in ....(case x of (p,q) -> rhs)....(foldr k z y).... + +We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold), +but we do want + + * the case-expression to simplify + (via exprIsConApp_maybe, exprIsLiteral_maybe) + + * the foldr/build RULE to fire + (by expanding the unfolding during rule matching) + +So we classify the unfolding of a let-binding as "expandable" (via the +uf_expandable field) if we want to do this kind of on-the-fly +expansion. Specifically: + +* True of constructor applications (K a b) + +* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic. + (NB: exprIsCheap might not be true of this) + +* False of case-expressions. If we have + let x = case ... in ...(case x of ...)... + we won't simplify. We have to inline x. See #14688. + +* False of let-expressions (same reason); and in any case we + float lets out of an RHS if doing so will reveal an expandable + application (see SimplEnv.doFloatFromRhs). + +* Take care: exprIsExpandable should /not/ be true of primops. I + found this in test T5623a: + let q = /\a. Ptr a (a +# b) + in case q @ Float of Ptr v -> ...q... + + q's inlining should not be expandable, else exprIsConApp_maybe will + say that (q @ Float) expands to (Ptr a (a +# b)), and that will + duplicate the (a +# b) primop, which we should not do lightly. + (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) + Note [isExpandableApp: bottoming functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important that isExpandableApp does not respond True to bottoming @@ -1541,10 +1527,10 @@ expr_ok fun_ok primop_ok (Case scrut bndr _ alts) && altsAreExhaustive alts expr_ok fun_ok primop_ok other_expr - | (expr, args) <- collectArgs other_expr + | (expr, val_args) <- collectValArgs other_expr = case stripTicksTopE (not . tickishCounts) expr of Var f -> - app_ok fun_ok primop_ok f args + app_ok fun_ok primop_ok f val_args -- 'LitRubbish' is the only literal that can occur in the head of an -- application and will not be matched by the above case (Var /= Lit). @@ -1558,8 +1544,8 @@ expr_ok fun_ok primop_ok other_expr _ -> False ----------------------------- -app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool -app_ok fun_ok primop_ok fun args +app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreArg] -> Bool +app_ok fun_ok primop_ok fun val_args | not (fun_ok fun) = False -- This code path is only taken for Note [Speculative evaluation] | otherwise @@ -1568,21 +1554,22 @@ app_ok fun_ok primop_ok fun args -- DFuns terminate, unless the dict is implemented -- with a newtype in which case they may not - DataConWorkId {} -> True - -- The strictness of the constructor has already - -- been expressed by its "wrapper", so we don't need - -- to take the arguments into account + DataConWorkId dc + | Just str_marks <- dataConRepStrictness_maybe dc + -> all3Prefix field_ok str_marks val_arg_tys val_args + | otherwise + -> all2Prefix arg_ok val_arg_tys val_args ClassOpId _ is_terminating_result | is_terminating_result -- See Note [exprOkForSpeculation and type classes] - -> assertPpr (n_val_args == 1) (ppr fun $$ ppr args) $ + -> assertPpr (n_val_args == 1) (ppr fun $$ ppr val_args) $ True -- assert: terminating result type => can't be applied; -- c.f the _other case below PrimOpId op _ | primOpIsDiv op - , [arg1, Lit lit] <- args + , [arg1, Lit lit] <- val_args -> not (isZeroLit lit) && expr_ok fun_ok primop_ok arg1 -- Special case for dividing operations that fail -- In general they are NOT ok-for-speculation @@ -1600,13 +1587,13 @@ app_ok fun_ok primop_ok fun args | otherwise -> primop_ok op -- Check the primop itself - && and (zipWith arg_ok arg_tys args) -- Check the arguments + && all2Prefix arg_ok val_arg_tys val_args -- Check the arguments _other -- Unlifted and terminating types; -- Also c.f. the Var case of exprIsHNF | isTerminatingType fun_ty -- See Note [exprOkForSpeculation and type classes] || definitelyUnliftedType fun_ty - -> assertPpr (n_val_args == 0) (ppr fun $$ ppr args) + -> assertPpr (n_val_args == 0) (ppr fun $$ ppr val_args) True -- Both terminating types (e.g. Eq a), and unlifted types (e.g. Int#) -- are non-functions and so will have no value args. The assert is -- just to check this. @@ -1615,7 +1602,7 @@ app_ok fun_ok primop_ok fun args -- Partial applications | idArity fun > n_val_args -> - and (zipWith arg_ok arg_tys args) -- Check the arguments + all2Prefix arg_ok val_arg_tys val_args -- Check the arguments -- Functions that terminate fast without raising exceptions etc -- See Note [Discarding unnecessary unsafeEqualityProofs] @@ -1627,18 +1614,27 @@ app_ok fun_ok primop_ok fun args -- see Note [exprOkForSpeculation and evaluated variables] where fun_ty = idType fun - n_val_args = valArgCount args + n_val_args = length val_args (arg_tys, _) = splitPiTys fun_ty + val_arg_tys = mapMaybe anonPiTyBinderType_maybe arg_tys -- Used for arguments to primops and to partial applications - arg_ok :: PiTyVarBinder -> CoreExpr -> Bool - arg_ok (Named _) _ = True -- A type argument - arg_ok (Anon ty _) arg -- A term argument - | definitelyLiftedType (scaledThing ty) + arg_ok :: Type -> CoreExpr -> Bool + arg_ok ty arg + | definitelyLiftedType ty = True -- See Note [Primops with lifted arguments] | otherwise = expr_ok fun_ok primop_ok arg + -- Used for DataCon worker arguments + field_ok :: StrictnessMark -> Type -> CoreExpr -> Bool + field_ok str ty arg -- A term argument + | NotMarkedStrict <- str -- iff it's a lazy field + , definitelyLiftedType ty -- and its type is lifted + = True -- then the worker app does not eval + | otherwise + = expr_ok fun_ok primop_ok arg + ----------------------------- altsAreExhaustive :: [Alt b] -> Bool -- True <=> the case alternatives are definitely exhaustive @@ -1905,12 +1901,14 @@ exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding -- or PAPs. -- exprIsHNFlike :: HasDebugCallStack => (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool -exprIsHNFlike is_con is_con_unf = is_hnf_like +exprIsHNFlike is_con is_con_unf e + = -- pprTraceWith "hnf" (\r -> ppr r <+> ppr e) $ + is_hnf_like e where is_hnf_like (Var v) -- NB: There are no value args at this point - = id_app_is_value v 0 -- Catches nullary constructors, - -- so that [] and () are values, for example - -- and (e.g.) primops that don't have unfoldings + = id_app_is_value v [] -- Catches nullary constructors, + -- so that [] and () are values, for example + -- and (e.g.) primops that don't have unfoldings || is_con_unf (idUnfolding v) -- Check the thing's unfolding; it might be bound to a value -- or to a guaranteed-evaluated variable (isEvaldUnfolding) @@ -1934,31 +1932,57 @@ exprIsHNFlike is_con is_con_unf = is_hnf_like -- See Note [exprIsHNF Tick] is_hnf_like (Cast e _) = is_hnf_like e is_hnf_like (App e a) - | isValArg a = app_is_value e 1 + | isValArg a = app_is_value e [a] | otherwise = is_hnf_like e is_hnf_like (Let _ e) = is_hnf_like e -- Lazy let(rec)s don't affect us is_hnf_like _ = False - -- 'n' is the number of value args to which the expression is applied - -- And n>0: there is at least one value argument - app_is_value :: CoreExpr -> Int -> Bool - app_is_value (Var f) nva = id_app_is_value f nva - app_is_value (Tick _ f) nva = app_is_value f nva - app_is_value (Cast f _) nva = app_is_value f nva - app_is_value (App f a) nva - | isValArg a = - app_is_value f (nva + 1) && - not (needsCaseBinding (exprType a) a) - -- For example f (x /# y) where f has arity two, and the first - -- argument is unboxed. This is not a value! - -- But f 34# is a value. - -- NB: Check app_is_value first, the arity check is cheaper - | otherwise = app_is_value f nva - app_is_value _ _ = False - - id_app_is_value id n_val_args - = is_con id - || idArity id > n_val_args + -- Collect arguments through Casts and Ticks and call id_app_is_value + app_is_value :: CoreExpr -> [CoreArg] -> Bool + app_is_value (Var f) as = id_app_is_value f as + app_is_value (Tick _ f) as = app_is_value f as + app_is_value (Cast f _) as = app_is_value f as + app_is_value (App f a) as | isValArg a = app_is_value f (a:as) + | otherwise = app_is_value f as + app_is_value _ _ = False + + id_app_is_value id val_args + -- First handle saturated applications of DataCons with strict fields + | Just dc <- isDataConWorkId_maybe id -- DataCon + , Just str_marks <- dataConRepStrictness_maybe dc -- with strict fields + , assert (val_args `leLength` str_marks) True + , val_args `equalLength` str_marks -- in a saturated app + = all3Prefix check_field str_marks val_arg_tys val_args + + -- Now all applications except saturated DataCon apps with strict fields + | idArity id > length val_args + -- PAP: Check unlifted val_args + || is_con id && isNothing (isDataConWorkId_maybe id >>= dataConRepStrictness_maybe) + -- Either a lazy DataCon or a CONLIKE. + -- Hence we only need to check unlifted val_args here. + -- NB: We assume that CONLIKEs are lazy, which is their entire + -- point. + = all2Prefix check_arg val_arg_tys val_args + + | otherwise + = False + where + fun_ty = idType id + (arg_tys,_) = splitPiTys fun_ty + val_arg_tys = mapMaybe anonPiTyBinderType_maybe arg_tys + -- val_arg_tys = map exprType val_args, but much less costly. + -- The obvious definition regresses T16577 by 30% so we don't do it. + + check_arg a_ty a = mightBeUnliftedType a_ty ==> is_hnf_like a + -- Check unliftedness; for example f (x /# 12#) where f has arity two, + -- and the first argument is unboxed. This is not a value! + -- But f 34# is a value, so check args for HNFs. + -- NB: We check arity (and CONLIKEness) first because it's cheaper + -- and we reject quickly on saturated apps. + check_field str a_ty a + = isMarkedStrict str || mightBeUnliftedType a_ty ==> is_hnf_like a + a ==> b = not a || b + infixr 1 ==> {- Note [exprIsHNF Tick] @@ -2520,7 +2544,7 @@ This means the seqs on x and y both become no-ops and compared to the first vers The downside is that the caller of $wfoo potentially has to evaluate `y` once if we can't prove it isn't already evaluated. But y coming out of a strict field is in WHNF so safe to evaluated. And most of the time it will be properly tagged+evaluated -already at the call site because of the Strict Field Invariant! See Note [Strict Field Invariant] for more in this. +already at the call site because of the Strict Field Invariant! See Note [STG Strict Field Invariant] for more in this. This makes GHC itself around 1% faster despite doing slightly more work! So this is generally quite good. We only apply this when we think there is a benefit in doing so however. There are a number of cases in which ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -64,8 +64,8 @@ With nofib being ~0.3% faster as well. See Note [Tag inference passes] for how we proceed to generate and use this information. -Note [Strict Field Invariant] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [STG Strict Field Invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As part of tag inference we introduce the Strict Field Invariant. Which consists of us saying that: @@ -124,15 +124,33 @@ Note that there are similar constraints around Note [CBV Function Ids]. Note [How untagged pointers can end up in strict fields] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Since the resolution of #20749 where Core passes assume that DataCon workers +evaluate their strict fields, it is pretty simple to see how the Simplifier +might exploit that knowledge to drop evals. Example: + + data MkT a = MkT !a + f :: [Int] -> T [Int] + f xs = xs `seq` MkT xs + +in Core we will have + + f = \xs -> MkT @[Int] xs + +No eval left there. + Consider data Set a = Tip | Bin !a (Set a) (Set a) We make a wrapper for Bin that evaluates its arguments $WBin x a b = case x of xv -> Bin xv a b Here `xv` will always be evaluated and properly tagged, just as the -Strict Field Invariant requires. +Note [STG Strict Field Invariant] requires. + +But alas, the Simplifier can destroy the invariant: see #15696. +Indeed, as Note [Strict fields in Core] explains, Core passes +assume that Data constructor workers evaluate their strict fields, +so the Simplifier will drop seqs freely. -But alas the Simplifier can destroy the invariant: see #15696. We start with thk = f () g x = ...(case thk of xv -> Bin xv Tip Tip)... @@ -153,7 +171,7 @@ Now you can see that the argument of Bin, namely thk, points to the thunk, not to the value as it did before. In short, although it may be rare, the output of optimisation passes -cannot guarantee to obey the Strict Field Invariant. For this reason +cannot guarantee to obey the Note [STG Strict Field Invariant]. For this reason we run tag inference. See Note [Tag inference passes]. Note [Tag inference passes] @@ -163,7 +181,7 @@ Tag inference proceeds in two passes: The result is then attached to /binders/. This is implemented by `inferTagsAnal` in GHC.Stg.InferTags * The second pass walks over the AST checking if the Strict Field Invariant is upheld. - See Note [Strict Field Invariant]. + See Note [STG Strict Field Invariant]. If required this pass modifies the program to uphold this invariant. Tag information is also moved from /binders/ to /occurrences/ during this pass. This is done by `GHC.Stg.InferTags.Rewrite (rewriteTopBinds)`. ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -64,7 +64,7 @@ The work of this pass is simple: * For any strict field we check if the argument is known to be properly tagged. * If it's not known to be properly tagged, we wrap the whole thing in a case, which will force the argument before allocation. -This is described in detail in Note [Strict Field Invariant]. +This is described in detail in Note [STG Strict Field Invariant]. The only slight complication is that we have to make sure not to invalidate free variable analysis in the process. @@ -217,7 +217,7 @@ When compiling bytecode we call myCoreToStg to get STG code first. myCoreToStg in turn calls out to stg2stg which runs the STG to STG passes followed by free variables analysis and the tag inference pass including it's rewriting phase at the end. -Running tag inference is important as it upholds Note [Strict Field Invariant]. +Running tag inference is important as it upholds Note [STG Strict Field Invariant]. While code executed by GHCi doesn't take advantage of the SFI it can call into compiled code which does. So it must still make sure that the SFI is upheld. See also #21083 and #22042. ===================================== compiler/GHC/Tc/TyCl/Build.hs ===================================== @@ -176,12 +176,13 @@ buildDataCon fam_envs dc_bang_opts src_name declared_infix prom_info src_bangs tag = lookupNameEnv_NF tag_map src_name -- See Note [Constructor tag allocation], fixes #14657 data_con = mkDataCon src_name declared_infix prom_info - src_bangs field_lbls + src_bangs impl_bangs str_marks field_lbls univ_tvs ex_tvs user_tvbs eq_spec ctxt arg_tys res_ty NoPromInfo rep_tycon tag stupid_ctxt dc_wrk dc_rep dc_wrk = mkDataConWorkId work_name data_con - dc_rep = initUs_ us (mkDataConRep dc_bang_opts fam_envs wrap_name data_con) + (dc_rep, impl_bangs, str_marks) = + initUs_ us (mkDataConRep dc_bang_opts fam_envs wrap_name data_con) ; traceIf (text "buildDataCon 2" <+> ppr src_name) ; return data_con } ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -1390,33 +1390,8 @@ arguments. That is the job of dmdTransformDataConSig. More precisely, * it returns the demands on the arguments; in the above example that is [SL, A] -Nasty wrinkle. Consider this code (#22475 has more realistic examples but -assume this is what the demand analyser sees) - - data T = MkT !Int Bool - get :: T -> Bool - get (MkT _ b) = b - - foo = let v::Int = I# 7 - t::T = MkT v True - in get t - -Now `v` is unused by `get`, /but/ we can't give `v` an Absent demand, -else we'll drop the binding and replace it with an error thunk. -Then the code generator (more specifically GHC.Stg.InferTags.Rewrite) -will add an extra eval of MkT's argument to give - foo = let v::Int = error "absent" - t::T = case v of v' -> MkT v' True - in get t - -Boo! Because of this extra eval (added in STG-land), the truth is that `MkT` -may (or may not) evaluate its arguments (as established in #21497). Hence the -use of `bump` in dmdTransformDataConSig, which adds in a `C_01` eval. The -`C_01` says "may or may not evaluate" which is absolutely faithful to what -InferTags.Rewrite does. - -In particular it is very important /not/ to make that a `C_11` eval, -see Note [Data-con worker strictness]. +When the data constructor worker has strict fields, they act as additional +seqs; hence we add an additional `C_11` eval. -} {- ********************************************************************* @@ -1616,6 +1591,29 @@ a bad fit because expression may not throw a precise exception (increasing precision of the analysis), but that's just a favourable guess. +Note [Side-effects and strictness] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Due to historic reasons and the continued effort not to cause performance +regressions downstream, Strictness Analysis is currently prone to discarding +observable side-effects (other than precise exceptions, see +Note [Precise exceptions and strictness]) in some cases. For example, + f :: MVar () -> Int -> IO Int + f mv x = putMVar mv () >> (x `seq` return x) +The call to `putMVar` is an observable side-effect. Yet, Strictness Analysis +currently concludes that `f` is strict in `x` and uses call-by-value. +That means `f mv (error "boom")` will error out with the imprecise exception +rather performing the side-effect. + +This is a conscious violation of the semantics described in the paper +"a semantics for imprecise exceptions"; so it would be great if we could +identify the offending primops and extend the idea in +Note [Which scrutinees may throw precise exceptions] to general side-effects. + +Unfortunately, the existing has-side-effects classification for primops is +too conservative, listing `writeMutVar#` and even `readMutVar#` as +side-effecting. That is due to #3207. A possible way forward is described in +#17900, but no effort has been so far towards a resolution. + Note [Exceptions and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We used to smart about catching exceptions, but we aren't anymore. @@ -2326,7 +2324,7 @@ dmdTransformDataConSig str_marks sd = case viewProd arity body_sd of mk_body_ty n dmds = DmdType emptyDmdEnv (zipWith (bump n) str_marks dmds) topDiv bump n str dmd | isMarkedStrict str = multDmd n (plusDmd str_field_dmd dmd) | otherwise = multDmd n dmd - str_field_dmd = C_01 :* seqSubDmd -- Why not C_11? See Note [Data-con worker strictness] + str_field_dmd = C_11 :* seqSubDmd -- See Note [Strict fields in Core] -- | A special 'DmdTransformer' for dictionary selectors that feeds the demand -- on the result into the indicated dictionary component (if saturated). ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -220,7 +220,7 @@ The invariants around the arguments of call by value function like Ids are then: * Any `WorkerLikeId` * Some `JoinId` bindings. -This works analogous to the Strict Field Invariant. See also Note [Strict Field Invariant]. +This works analogous to the Strict Field Invariant. See also Note [STG Strict Field Invariant]. To make this work what we do is: * During W/W and SpecConstr any worker/specialized binding we introduce ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -56,7 +56,7 @@ import GHC.Core.Coercion import GHC.Core.Reduction import GHC.Core.Make import GHC.Core.FVs ( mkRuleInfo ) -import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, coreAltsType ) +import GHC.Core.Utils ( exprType, mkCast, coreAltsType ) import GHC.Core.Unfold.Make import GHC.Core.SimpleOpt import GHC.Core.TyCon @@ -586,8 +586,12 @@ mkDataConWorkId wkr_name data_con = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info where - tycon = dataConTyCon data_con -- The representation TyCon - wkr_ty = dataConRepType data_con + tycon = dataConTyCon data_con -- The representation TyCon + wkr_ty = dataConRepType data_con + univ_tvs = dataConUnivTyVars data_con + ex_tcvs = dataConExTyCoVars data_con + arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys + str_marks = dataConRepStrictness data_con ----------- Workers for data types -------------- alg_wkr_info = noCafIdInfo @@ -595,15 +599,19 @@ mkDataConWorkId wkr_name data_con `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 - -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon + `setDmdSigInfo` wkr_sig + -- Workers eval their strict fields + -- See Note [Strict fields in Core] wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + wkr_sig = mkClosedDmdSig wkr_dmds topDiv + wkr_dmds = map mk_dmd str_marks + mk_dmd MarkedStrict = evalDmd + mk_dmd NotMarkedStrict = topDmd + ----------- Workers for newtypes -------------- - univ_tvs = dataConUnivTyVars data_con - ex_tcvs = dataConExTyCoVars data_con - arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` dataConWrapperInlinePragma @@ -686,10 +694,10 @@ mkDataConRep :: DataConBangOpts -> FamInstEnvs -> Name -> DataCon - -> UniqSM DataConRep + -> UniqSM (DataConRep, [HsImplBang], [StrictnessMark]) mkDataConRep dc_bang_opts fam_envs wrap_name data_con | not wrapper_reqd - = return NoDataConRep + = return (NoDataConRep, arg_ibangs, rep_strs) | otherwise = do { wrap_args <- mapM (newLocal (fsLit "conrep")) wrap_arg_tys @@ -744,11 +752,8 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con ; return (DCR { dcr_wrap_id = wrap_id , dcr_boxer = mk_boxer boxers - , dcr_arg_tys = rep_tys - , dcr_stricts = rep_strs - -- For newtypes, dcr_bangs is always [HsLazy]. - -- See Note [HsImplBangs for newtypes]. - , dcr_bangs = arg_ibangs }) } + , dcr_arg_tys = rep_tys } + , arg_ibangs, rep_strs) } where (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty) @@ -793,8 +798,8 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con (not new_tycon -- (Most) newtypes have only a worker, with the exception -- of some newtypes written with GADT syntax. See below. - && (any isBanged (ev_ibangs ++ arg_ibangs))) - -- Some forcing/unboxing (includes eq_spec) + && (any isUnpacked (ev_ibangs ++ arg_ibangs))) + -- Some unboxing (includes eq_spec) || isFamInstTyCon tycon -- Cast result || dataConUserTyVarsNeedWrapper data_con -- If the data type was written with GADT syntax and @@ -1057,7 +1062,7 @@ dataConArgRep arg_ty HsLazy = ([(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer)) dataConArgRep arg_ty (HsStrict _) - = ([(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer)) + = ([(arg_ty, MarkedStrict)], (unitUnboxer, unitBoxer)) -- Seqs are inserted in STG dataConArgRep arg_ty (HsUnpack Nothing) = dataConArgUnpack arg_ty @@ -1087,9 +1092,6 @@ wrapCo co rep_ty (unbox_rep, box_rep) -- co :: arg_ty ~ rep_ty ; return (rep_ids, rep_expr `Cast` mkSymCo sco) } ------------------------ -seqUnboxer :: Unboxer -seqUnboxer v = return ([v], mkDefaultCase (Var v) v) - unitUnboxer :: Unboxer unitUnboxer v = return ([v], \e -> e) ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Utils.Misc ( dropWhileEndLE, spanEnd, last2, lastMaybe, onJust, - List.foldl1', foldl2, count, countWhile, all2, + List.foldl1', foldl2, count, countWhile, all2, all2Prefix, all3Prefix, lengthExceeds, lengthIs, lengthIsNot, lengthAtLeast, lengthAtMost, lengthLessThan, @@ -646,6 +646,25 @@ all2 _ [] [] = True all2 p (x:xs) (y:ys) = p x y && all2 p xs ys all2 _ _ _ = False +all2Prefix :: (a -> b -> Bool) -> [a] -> [b] -> Bool +-- ^ `all2Prefix p xs ys` is a fused version of `and $ zipWith2 p xs ys`. +-- So if one list is shorter than the other, `p` is assumed to be `True` for the +-- suffix. +all2Prefix p xs ys = go xs ys + where go (x:xs) (y:ys) = p x y && go xs ys + go _ _ = True +{-# INLINABLE all2Prefix #-} + +all3Prefix :: (a -> b -> c -> Bool) -> [a] -> [b] -> [c] -> Bool +-- ^ `all3Prefix p xs ys zs` is a fused version of `and $ zipWith3 p xs ys zs`. +-- So if one list is shorter than the others, `p` is assumed to be `True` for +-- the suffix. +all3Prefix p xs ys zs = go xs ys zs + where + go (x:xs) (y:ys) (z:zs) = p x y z && go xs ys zs + go _ _ _ = True +{-# INLINABLE all3Prefix #-} + -- Count the number of times a predicate is true count :: (a -> Bool) -> [a] -> Int ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -138,9 +138,9 @@ mapMaybeRule [InlPrag=[2]] :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, Arity=1, - Str=<1!P(L,LC(S,C(1,C(1,P(L,1L)))))>, - Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, + Str=<1!P(SL,LC(S,C(1,C(1,P(L,1L)))))>, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@b) (f [Occ=Once1!] :: Rule IO a b) -> case f of { Rule @s ww ww1 [Occ=OnceL1!] -> @@ -219,36 +219,41 @@ mapMaybeRule -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18013.$trModule4 :: GHC.Prim.Addr# [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 20 0}] T18013.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T18013.$trModule3 :: GHC.Types.TrName [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T18013.$trModule3 = GHC.Types.TrNameS T18013.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18013.$trModule2 :: GHC.Prim.Addr# [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 30 0}] T18013.$trModule2 = "T18013"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T18013.$trModule1 :: GHC.Types.TrName [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T18013.$trModule1 = GHC.Types.TrNameS T18013.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T18013.$trModule :: GHC.Types.Module [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T18013.$trModule = GHC.Types.Module T18013.$trModule3 T18013.$trModule1 ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -417,7 +417,10 @@ test('T21391', normal, compile, ['-O -dcore-lint']) test('T22112', normal, compile, ['-O -dsuppress-uniques -dno-typeable-binds -ddump-simpl']) test('T21391a', normal, compile, ['-O -dcore-lint']) # We don't want to see a thunk allocation for the insertBy expression after CorePrep. -test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]'), expect_broken(21392) ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques']) +# Unfortunately, this test is no longer broken after we made workers strict in strict fields, +# so it is no longer a reproducer for T21392. Still, it doesn't hurt if we test that we don't +# regress again. +test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]') ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques']) test('T21689', [extra_files(['T21689a.hs'])], multimod_compile, ['T21689', '-v0 -O']) test('T21801', normal, compile, ['-O -dcore-lint']) test('T21848', [grep_errmsg(r'SPEC wombat') ], compile, ['-O -ddump-spec']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90383d3bd65dec38bd46716726640e6778f2a732 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90383d3bd65dec38bd46716726640e6778f2a732 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 13:09:07 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Thu, 02 Mar 2023 08:09:07 -0500 Subject: [Git][ghc/ghc][wip/T20749] Make DataCon workers strict in strict fields (#20749) Message-ID: <64009ff3db69_2100182c1c4e8c457582@gitlab.mail> Sebastian Graf pushed to branch wip/T20749 at Glasgow Haskell Compiler / GHC Commits: 9a759195 by Sebastian Graf at 2023-03-02T14:08:49+01:00 Make DataCon workers strict in strict fields (#20749) This patch tweaks `exprIsConApp_maybe`, `exprIsHNF` and friends, and Demand Analysis so that they exploit and maintain strictness of DataCon workers. See `Note [Strict fields in Core]` for details. Very little needed to change, and it puts field seq insertion done by Tag Inference into a new perspective: That of *implementing* strict field semantics. Before Tag Inference, DataCon workers are strict. Afterwards they are effectively lazy and field seqs happen around use sites. History has shown that there is no other way to guarantee taggedness and thus the STG Strict Field Invariant. There's also a functional change to `exprIsHNF`, which previously used `exprOkForSpeculation` on unlifted arguments instead of recursing into `exprIsHNF`. That regressed the termination analysis in CPR analysis (which simply calls out to `exprIsHNF`), so I made it call `exprOkForSpeculation`, too. There's a small regression in Demand Analysis, visible in the changed test output of T16859: Previously, a field seq on a variable would give that variable a "used exactly once" demand, now it's "used at least once", because `dmdTransformDataConSig` accounts for future uses of the field that actually all go through the case binder (and hence won't re-enter the potential thunk). The difference should hardly be observable. Unfortunately, T21392 does no longer reproduce after this patch, so I marked it as "not broken" in order to track whether we regress again in the future. Fixes #20749, the satisfying conclusion of an annoying saga (cf. the ideas in #21497 and #22475). - - - - - 21 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Misc.hs - testsuite/tests/simplCore/should_compile/T18013.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/stranal/sigs/T16859.stderr Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -615,6 +615,8 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri -- See Note [Constructor tag allocation] and #14657 data_con = mkDataCon dc_name declared_infix prom_info (map (const no_bang) arg_tys) + (map (const HsLazy) arg_tys) + (map (const NotMarkedStrict) arg_tys) [] -- No labelled fields tyvars ex_tyvars (mkTyVarBinders SpecifiedSpec user_tyvars) ===================================== compiler/GHC/Core.hs ===================================== @@ -42,7 +42,7 @@ module GHC.Core ( foldBindersOfBindStrict, foldBindersOfBindsStrict, collectBinders, collectTyBinders, collectTyAndValBinders, collectNBinders, collectNValBinders_maybe, - collectArgs, stripNArgs, collectArgsTicks, flattenBinds, + collectArgs, collectValArgs, stripNArgs, collectArgsTicks, flattenBinds, collectFunSimple, exprToType, @@ -983,6 +983,60 @@ tail position: A cast changes the type, but the type must be the same. But operationally, casts are vacuous, so this is a bit unfortunate! See #14610 for ideas how to fix this. +Note [Strict fields in Core] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Evaluating a data constructor worker evaluates its strict fields. + +In other words, if `MkT` is strict in its first field and `xs` reduces to +`error "boom"`, then `MkT xs b` will throw that error. +Conversely, it is sound to seq the field before the call to the constructor, +e.g., with `case xs of xs' { __DEFAULT -> MkT xs' b }`. +Let's call this transformation "field seq insertion". + +Note in particular that the data constructor application `MkT xs b` above is +*not* a value, unless `xs` is! + +This has pervasive effect on the Core pipeline: + + * `exprIsHNF`/`exprIsConLike`/`exprOkForSpeculation` need to assert that the + strict arguments of a DataCon worker are values/ok-for-spec themselves. + + * `exprIsConApp_maybe` inserts field seqs in the `FloatBind`s it returns, so + that the Simplifier, Constant-folding, the pattern-match checker, etc. + all see the insert field seqs when they match on strict workers. Often this + is just to emphasise strict semantics, but for case-of-known constructor + and case-to-let field insertion is *vital*, otherwise these transformations + would lose field seqs. + + * The demand signature of a data constructor is strict in strict field + position, whereas is it's normally lazy. Likewise the demand *transformer* + of a DataCon worker can add stricten up demands on strict field args. + See Note [Demand transformer for data constructors]. + + * In the absence of `-fpedantic-bottoms`, it is still possible that some seqs + are ultimately dropped or delayed due to eta-expansion. + See Note [Dealing with bottom]. + +Strict field semantics is exploited in STG by Note [Tag Inference]: +It performs field seq insertion to statically guarantee *taggedness* of strict +fields, establishing the Note [STG Strict Field Invariant]. (Happily, most +of those seqs are immediately detected as redundant by tag inference and are +omitted.) From then on, DataCon worker semantics are actually lazy, hence it is +important that STG passes maintain the Strict Field Invariant. + + +Historical Note: +The delightfully simple description of strict field semantics is the result of +a long saga (#20749, the bits about strict data constructors in #21497, #22475), +where we tried a more lenient (but actually not) semantics first that would +allow both strict and lazy implementations of DataCon workers. This was favoured +because the "pervasive effect" throughout the compiler was deemed too large +(when it really turned out to be very modest). +Alas, this semantics would require us to implement `exprIsHNF` in *exactly* the +same way as above, otherwise the analysis would not be conservative wrt. the +lenient semantics (which includes the strict one). It is also much harder to +explain and maintain, as it turned out. + ************************************************************************ * * In/Out type synonyms @@ -2043,6 +2097,17 @@ collectArgs expr go (App f a) as = go f (a:as) go e as = (e, as) +-- | Takes a nested application expression and returns the function +-- being applied and the arguments to which it is applied +collectValArgs :: Expr b -> (Expr b, [Arg b]) +collectValArgs expr + = go expr [] + where + go (App f a) as + | isValArg a = go f (a:as) + | otherwise = go f as + go e as = (e, as) + -- | Takes a nested application expression and returns the function -- being applied. Looking through casts and ticks to find it. collectFunSimple :: Expr b -> Expr b ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -48,7 +48,8 @@ module GHC.Core.DataCon ( dataConIsInfix, dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitTyThings, - dataConRepStrictness, dataConImplBangs, dataConBoxer, + dataConRepStrictness, dataConRepStrictness_maybe, + dataConImplBangs, dataConBoxer, splitDataProductType_maybe, @@ -59,7 +60,7 @@ module GHC.Core.DataCon ( isVanillaDataCon, isNewDataCon, isTypeDataCon, classDataCon, dataConCannotMatch, dataConUserTyVarsNeedWrapper, checkDataConTyVars, - isBanged, isMarkedStrict, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked, + isBanged, isUnpacked, isMarkedStrict, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked, specialPromotedDc, -- ** Promotion related functions @@ -95,6 +96,7 @@ import GHC.Types.Unique.FM ( UniqFM ) import GHC.Types.Unique.Set import GHC.Builtin.Uniques( mkAlphaTyVarUnique ) import GHC.Data.Graph.UnVar -- UnVarSet and operations +import GHC.Data.Maybe (orElse) import GHC.Utils.Outputable import GHC.Utils.Misc @@ -501,6 +503,18 @@ data DataCon -- Matches 1-1 with dcOrigArgTys -- Hence length = dataConSourceArity dataCon + dcImplBangs :: [HsImplBang], + -- The actual decisions made (including failures) + -- about the original arguments; 1-1 with orig_arg_tys + -- See Note [Bangs on data constructor arguments] + + dcStricts :: [StrictnessMark], + -- One mark for every field of the DataCon worker; + -- if it's empty, then all fields are lazy, + -- otherwise it has the same length as dataConRepArgTys. + -- See also Note [Strict fields in Core] in GHC.Core + -- for the effect on the strictness signature + dcFields :: [FieldLabel], -- Field labels for this constructor, in the -- same order as the dcOrigArgTys; @@ -776,13 +790,6 @@ data DataConRep -- after unboxing and flattening, -- and *including* all evidence args - , dcr_stricts :: [StrictnessMark] -- 1-1 with dcr_arg_tys - -- See also Note [Data-con worker strictness] - - , dcr_bangs :: [HsImplBang] -- The actual decisions made (including failures) - -- about the original arguments; 1-1 with orig_arg_tys - -- See Note [Bangs on data constructor arguments] - } type DataConEnv a = UniqFM DataCon a -- Keyed by DataCon @@ -851,43 +858,8 @@ eqSpecPreds spec = [ mkPrimEqPred (mkTyVarTy tv) ty instance Outputable EqSpec where ppr (EqSpec tv ty) = ppr (tv, ty) -{- Note [Data-con worker strictness] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Notice that we do *not* say the worker Id is strict even if the data -constructor is declared strict - e.g. data T = MkT ![Int] Bool -Even though most often the evals are done by the *wrapper* $WMkT, there are -situations in which tag inference will re-insert evals around the worker. -So for all intents and purposes the *worker* MkT is strict, too! - -Unfortunately, if we exposed accurate strictness of DataCon workers, we'd -see the following transformation: - - f xs = case xs of xs' { __DEFAULT -> ... case MkT xs b of x { __DEFAULT -> [x] } } -- DmdAnal: Strict in xs - ==> { drop-seq, binder swap on xs' } - f xs = case MkT xs b of x { __DEFAULT -> [x] } -- DmdAnal: Still strict in xs - ==> { case-to-let } - f xs = let x = MkT xs' b in [x] -- DmdAnal: No longer strict in xs! - -I.e., we are ironically losing strictness in `xs` by dropping the eval on `xs` -and then doing case-to-let. The issue is that `exprIsHNF` currently says that -every DataCon worker app is a value. The implicit assumption is that surrounding -evals will have evaluated strict fields like `xs` before! But now that we had -just dropped the eval on `xs`, that assumption is no longer valid. - -Long story short: By keeping the demand signature lazy, the Simplifier will not -drop the eval on `xs` and using `exprIsHNF` to decide case-to-let and others -remains sound. - -Similarly, during demand analysis in dmdTransformDataConSig, we bump up the -field demand with `C_01`, *not* `C_11`, because the latter exposes too much -strictness that will drop the eval on `xs` above. - -This issue is discussed at length in -"Failed idea: no wrappers for strict data constructors" in #21497 and #22475. - -Note [Bangs on data constructor arguments] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Bangs on data constructor arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data T = MkT !Int {-# UNPACK #-} !Int Bool @@ -913,8 +885,8 @@ Terminology: the flag settings in the importing module. Also see Note [Bangs on imported data constructors] in GHC.Types.Id.Make -* The dcr_bangs field of the dcRep field records the [HsImplBang] - If T was defined in this module, Without -O the dcr_bangs might be +* The dcImplBangs field records the [HsImplBang] + If T was defined in this module, Without -O the dcImplBangs might be [HsStrict _, HsStrict _, HsLazy] With -O it might be [HsStrict _, HsUnpack _, HsLazy] @@ -958,6 +930,17 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. +* Core passes will often need to know whether the DataCon worker or wrapper in + an application is strict in some (lifted) field or not. This is tracked in the + demand signature attached to a DataCon's worker resp. wrapper Id. + + So if you've got a DataCon dc, you can get the demand signature by + `idDmdSig (dataConWorkId dc)` and make out strict args by testing with + `isStrictDmd`. Similarly, `idDmdSig <$> dataConWrapId_maybe dc` gives + you the demand signature of the wrapper, if it exists. + + These demand signatures are set in GHC.Types.Id.Make. + Note [Data con representation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The dcRepType field contains the type of the representation of a constructor @@ -973,14 +956,14 @@ what it means is the DataCon with all Unpacking having been applied. We can think of this as the Core representation. Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# + data Ord a => T a = MkT !Int a Void# Here T :: Ord a => Int -> a -> Void# -> T a but the rep type is Trep :: Int# -> a -> Void# -> T a Actually, the unboxed part isn't implemented yet! -Not that this representation is still *different* from runtime +Note that this representation is still *different* from runtime representation. (Which is what STG uses after unarise). This is how T would end up being used in STG post-unarise: @@ -1105,6 +1088,11 @@ isBanged (HsUnpack {}) = True isBanged (HsStrict {}) = True isBanged HsLazy = False +isUnpacked :: HsImplBang -> Bool +isUnpacked (HsUnpack {}) = True +isUnpacked (HsStrict {}) = False +isUnpacked HsLazy = False + isSrcStrict :: SrcStrictness -> Bool isSrcStrict SrcStrict = True isSrcStrict _ = False @@ -1130,13 +1118,15 @@ cbvFromStrictMark MarkedStrict = MarkedCbv -- | Build a new data constructor mkDataCon :: Name - -> Bool -- ^ Is the constructor declared infix? - -> TyConRepName -- ^ TyConRepName for the promoted TyCon - -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user - -> [FieldLabel] -- ^ Field labels for the constructor, - -- if it is a record, otherwise empty - -> [TyVar] -- ^ Universals. - -> [TyCoVar] -- ^ Existentials. + -> Bool -- ^ Is the constructor declared infix? + -> TyConRepName -- ^ TyConRepName for the promoted TyCon + -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user + -> [HsImplBang] -- ^ Strictness/unpack annotations, as inferred by the compiler + -> [StrictnessMark] -- ^ Strictness marks for the DataCon worker's fields in Core + -> [FieldLabel] -- ^ Field labels for the constructor, + -- if it is a record, otherwise empty + -> [TyVar] -- ^ Universals. + -> [TyCoVar] -- ^ Existentials. -> [InvisTVBinder] -- ^ User-written 'TyVarBinder's. -- These must be Inferred/Specified. -- See @Note [TyVarBinders in DataCons]@ @@ -1155,7 +1145,9 @@ mkDataCon :: Name -- Can get the tag from the TyCon mkDataCon name declared_infix prom_info - arg_stricts -- Must match orig_arg_tys 1-1 + arg_stricts -- Must match orig_arg_tys 1-1 + impl_bangs -- Must match orig_arg_tys 1-1 + str_marks -- Must be empty or match dataConRepArgTys 1-1 fields univ_tvs ex_tvs user_tvbs eq_spec theta @@ -1172,6 +1164,8 @@ mkDataCon name declared_infix prom_info = con where is_vanilla = null ex_tvs && null eq_spec && null theta + str_marks' | not $ any isMarkedStrict str_marks = [] + | otherwise = str_marks con = MkData {dcName = name, dcUnique = nameUnique name, dcVanilla = is_vanilla, dcInfix = declared_infix, @@ -1183,7 +1177,8 @@ mkDataCon name declared_infix prom_info dcStupidTheta = stupid_theta, dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty, dcRepTyCon = rep_tycon, - dcSrcBangs = arg_stricts, + dcSrcBangs = arg_stricts, dcImplBangs = impl_bangs, + dcStricts = str_marks', dcFields = fields, dcTag = tag, dcRepType = rep_ty, dcWorkId = work_id, dcRep = rep, @@ -1411,19 +1406,27 @@ isNullaryRepDataCon :: DataCon -> Bool isNullaryRepDataCon dc = dataConRepArity dc == 0 dataConRepStrictness :: DataCon -> [StrictnessMark] --- ^ Give the demands on the arguments of a --- Core constructor application (Con dc args) -dataConRepStrictness dc = case dcRep dc of - NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc] - DCR { dcr_stricts = strs } -> strs +-- ^ Give the demands on the runtime arguments of a Core DataCon worker +-- application. +-- The length of the list matches `dataConRepArgTys` (e.g., the number +-- of runtime arguments). +dataConRepStrictness dc + = dataConRepStrictness_maybe dc + `orElse` map (const NotMarkedStrict) (dataConRepArgTys dc) + +dataConRepStrictness_maybe :: DataCon -> Maybe [StrictnessMark] +-- ^ Give the demands on the runtime arguments of a Core DataCon worker +-- application or `Nothing` if all of them are lazy. +-- The length of the list matches `dataConRepArgTys` (e.g., the number +-- of runtime arguments). +dataConRepStrictness_maybe dc + | null (dcStricts dc) = Nothing + | otherwise = Just (dcStricts dc) dataConImplBangs :: DataCon -> [HsImplBang] -- The implementation decisions about the strictness/unpack of each -- source program argument to the data constructor -dataConImplBangs dc - = case dcRep dc of - NoDataConRep -> replicate (dcSourceArity dc) HsLazy - DCR { dcr_bangs = bangs } -> bangs +dataConImplBangs dc = dcImplBangs dc dataConBoxer :: DataCon -> Maybe DataConBoxer dataConBoxer (MkData { dcRep = DCR { dcr_boxer = boxer } }) = Just boxer ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -1461,7 +1461,7 @@ myExprIsCheap (AE { am_opts = opts, am_sigs = sigs }) e mb_ty -- See Note [Eta expanding through dictionaries] -- See Note [Eta expanding through CallStacks] - cheap_fun e = exprIsCheapX (myIsCheapApp sigs) e + cheap_fun e = exprIsCheapX (myIsCheapApp sigs) False e -- | A version of 'isCheapApp' that considers results from arity analysis. -- See Note [Arity analysis] for what's in the signature environment and why ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -46,7 +46,7 @@ import GHC.Core import GHC.Core.Make import GHC.Core.SimpleOpt ( exprIsConApp_maybe, exprIsLiteral_maybe ) import GHC.Core.DataCon ( DataCon,dataConTagZ, dataConTyCon, dataConWrapId, dataConWorkId ) -import GHC.Core.Utils ( cheapEqExpr, exprIsHNF +import GHC.Core.Utils ( cheapEqExpr, exprOkForSpeculation , stripTicksTop, stripTicksTopT, mkTicks ) import GHC.Core.Multiplicity import GHC.Core.Rules.Config @@ -1936,7 +1936,7 @@ Things to note Implementing seq#. The compiler has magic for SeqOp in -- GHC.Core.Opt.ConstantFold.seqRule: eliminate (seq# s) +- GHC.Core.Opt.ConstantFold.seqRule: eliminate (seq# s) - GHC.StgToCmm.Expr.cgExpr, and cgCase: special case for seq# @@ -1951,7 +1951,7 @@ Implementing seq#. The compiler has magic for SeqOp in seqRule :: RuleM CoreExpr seqRule = do [Type _ty_a, Type _ty_s, a, s] <- getArgs - guard $ exprIsHNF a + guard $ exprOkForSpeculation a return $ mkCoreUnboxedTuple [s, a] -- spark# :: forall a s . a -> State# s -> (# State# s, a #) ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -297,9 +297,16 @@ data TermFlag -- Better than using a Bool -- See Note [Nested CPR] exprTerminates :: CoreExpr -> TermFlag +-- ^ A /very/ simple termination analysis. exprTerminates e - | exprIsHNF e = Terminates -- A /very/ simple termination analysis. - | otherwise = MightDiverge + | exprIsHNF e = Terminates + | exprOkForSpeculation e = Terminates + | otherwise = MightDiverge + -- Annyingly, we have to check both for HNF and ok-for-spec. + -- * `I# (x# *# 2#)` is ok-for-spec, but not in HNF. Still worth CPR'ing! + -- * `lvl` is an HNF if its unfolding is evaluated + -- (perhaps `lvl = I# 0#` at top-level). But, tiresomely, it is never + -- ok-for-spec due to Note [exprOkForSpeculation and evaluated variables]. cprAnalApp :: AnalEnv -> CoreExpr -> [(CprType, CoreArg)] -> (CprType, CoreExpr) -- Main function that takes care of /nested/ CPR. See Note [Nested CPR] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -814,6 +814,10 @@ to the Divergence lattice, but in practice it turned out to be hard to untaint from 'topDiv' to 'conDiv', leading to bugs, performance regressions and complexity that didn't justify the single fixed testcase T13380c. +You might think that we should check for side-effects rather than just for +precise exceptions. Right you are! See Note [Side-effects and strictness] +for why we unfortunately do not. + Note [Demand analysis for recursive data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ T11545 features a single-product, recursive data type ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -8,14 +8,13 @@ module GHC.Core.Opt.Simplify.Env ( -- * The simplifier mode - SimplMode(..), updMode, - smPedanticBottoms, smPlatform, + SimplMode(..), updMode, smPlatform, -- * Environments SimplEnv(..), pprSimplEnv, -- Temp not abstract seArityOpts, seCaseCase, seCaseFolding, seCaseMerge, seCastSwizzle, seDoEtaReduction, seEtaExpand, seFloatEnable, seInline, seNames, - seOptCoercionOpts, sePedanticBottoms, sePhase, sePlatform, sePreInline, + seOptCoercionOpts, sePhase, sePlatform, sePreInline, seRuleOpts, seRules, seUnfoldingOpts, mkSimplEnv, extendIdSubst, extendTvSubst, extendCvSubst, @@ -216,9 +215,6 @@ seNames env = sm_names (seMode env) seOptCoercionOpts :: SimplEnv -> OptCoercionOpts seOptCoercionOpts env = sm_co_opt_opts (seMode env) -sePedanticBottoms :: SimplEnv -> Bool -sePedanticBottoms env = smPedanticBottoms (seMode env) - sePhase :: SimplEnv -> CompilerPhase sePhase env = sm_phase (seMode env) @@ -276,9 +272,6 @@ instance Outputable SimplMode where where pp_flag f s = ppUnless f (text "no") <+> s -smPedanticBottoms :: SimplMode -> Bool -smPedanticBottoms opts = ao_ped_bot (sm_arity_opts opts) - smPlatform :: SimplMode -> Platform smPlatform opts = roPlatform (sm_rule_opts opts) ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2063,8 +2063,8 @@ For applications of a data constructor worker, the full glory of rebuildCall is a waste of effort; * They never inline, obviously * They have no rewrite rules -* They are not strict (see Note [Data-con worker strictness] - in GHC.Core.DataCon) +* Though they might be strict (see Note [Strict fields in Core] in GHC.Core), + we will exploit that strictness through their demand signature So it's fine to zoom straight to `rebuild` which just rebuilds the call in a very straightforward way. @@ -3273,7 +3273,7 @@ a case pattern. This is *important*. Consider We really must record that b is already evaluated so that we don't go and re-evaluate it when constructing the result. -See Note [Data-con worker strictness] in GHC.Core.DataCon +See Note [Strict fields in Core] in GHC.Core. NB: simplLamBndrs preserves this eval info ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -1219,11 +1219,8 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr -- simplifier produces rhs[exp/a], changing semantics if exp is not ok-for-spec -- Good: returning (Mk#, [x]) with a float of case exp of x { DEFAULT -> [] } -- simplifier produces case exp of a { DEFAULT -> exp[x/a] } - = let arg' = subst_expr subst arg - bndr = uniqAway (subst_in_scope subst) (mkWildValBinder ManyTy arg_type) - float = FloatCase arg' bndr DEFAULT [] - subst' = subst_extend_in_scope subst bndr - in go subst' (float:floats) fun (CC (Var bndr : args) co) + , (subst', float, bndr) <- case_bind subst arg arg_type + = go subst' (float:floats) fun (CC (Var bndr : args) co) | otherwise = go subst floats fun (CC (subst_expr subst arg : args) co) @@ -1262,8 +1259,9 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr | Just con <- isDataConWorkId_maybe fun , count isValArg args == idArity fun - = succeedWith in_scope floats $ - pushCoDataCon con args co + , (in_scope', seq_floats, args') <- mkFieldSeqFloats in_scope con args + = succeedWith in_scope' (seq_floats ++ floats) $ + pushCoDataCon con args' co -- Look through data constructor wrappers: they inline late (See Note -- [Activation for data constructor wrappers]) but we want to do @@ -1349,6 +1347,36 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr extend (Left in_scope) v e = Right (extendSubst (mkEmptySubst in_scope) v e) extend (Right s) v e = Right (extendSubst s v e) + case_bind :: Either InScopeSet Subst -> CoreExpr -> Type -> (Either InScopeSet Subst, FloatBind, Id) + case_bind subst expr expr_ty = (subst', float, bndr) + where + bndr = setCaseBndrEvald MarkedStrict $ + uniqAway (subst_in_scope subst) $ + mkWildValBinder ManyTy expr_ty + subst' = subst_extend_in_scope subst bndr + expr' = subst_expr subst expr + float = FloatCase expr' bndr DEFAULT [] + + mkFieldSeqFloats :: InScopeSet -> DataCon -> [CoreExpr] -> (InScopeSet, [FloatBind], [CoreExpr]) + mkFieldSeqFloats in_scope dc args + | Nothing <- dataConRepStrictness_maybe dc + = (in_scope, [], args) + | otherwise + = (in_scope', floats', ty_args ++ val_args') + where + (ty_args, val_args) = splitAtList (dataConUnivAndExTyCoVars dc) args + (in_scope', floats', val_args') = foldr do_one (in_scope, [], []) $ zipEqual "mkFieldSeqFloats" str_marks val_args + str_marks = dataConRepStrictness dc + do_one (str, arg) (in_scope,floats,args) + | NotMarkedStrict <- str = (in_scope, floats, arg:args) + | Var v <- arg, is_evald v = (in_scope, floats, arg:args) + | otherwise = (in_scope', float:floats, Var bndr:args) + where + is_evald v = isId v && isEvaldUnfolding (idUnfolding v) + (in_scope', float, bndr) = + case case_bind (Left in_scope) arg (exprType arg) of + (Left in_scope', float, bndr) -> (in_scope', float, bndr) + (right, _, _) -> pprPanic "case_bind did not preserve Left" (ppr in_scope $$ ppr arg $$ ppr right) -- See Note [exprIsConApp_maybe on literal strings] dealWithStringLiteral :: Var -> BS.ByteString -> Coercion ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1220,18 +1220,23 @@ in this (which it previously was): in \w. v True -} --------------------- -exprIsWorkFree :: CoreExpr -> Bool -- See Note [exprIsWorkFree] -exprIsWorkFree e = exprIsCheapX isWorkFreeApp e - -exprIsCheap :: CoreExpr -> Bool -exprIsCheap e = exprIsCheapX isCheapApp e +------------------------------------- +type CheapAppFun = Id -> Arity -> Bool + -- Is an application of this function to n *value* args + -- always cheap, assuming the arguments are cheap? + -- True mainly of data constructors, partial applications; + -- but with minor variations: + -- isWorkFreeApp + -- isCheapApp + -- isExpandableApp -exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool +exprIsCheapX :: CheapAppFun -> Bool -> CoreExpr -> Bool {-# INLINE exprIsCheapX #-} --- allow specialization of exprIsCheap and exprIsWorkFree +-- allow specialization of exprIsCheap, exprIsWorkFree and exprIsExpandable -- instead of having an unknown call to ok_app -exprIsCheapX ok_app e +-- expandable: Only True for exprIsExpandable, where Case and Let are never +-- expandable. +exprIsCheapX ok_app expandable e = ok e where ok e = go 0 e @@ -1242,98 +1247,34 @@ exprIsCheapX ok_app e go _ (Type {}) = True go _ (Coercion {}) = True go n (Cast e _) = go n e - go n (Case scrut _ _ alts) = ok scrut && - and [ go n rhs | Alt _ _ rhs <- alts ] go n (Tick t e) | tickishCounts t = False | otherwise = go n e go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e | otherwise = go n e go n (App f e) | isRuntimeArg e = go (n+1) f && ok e | otherwise = go n f - go n (Let (NonRec _ r) e) = go n e && ok r - go n (Let (Rec prs) e) = go n e && all (ok . snd) prs + go n (Case scrut _ _ alts) = not expandable && ok scrut && + and [ go n rhs | Alt _ _ rhs <- alts ] + go n (Let (NonRec _ r) e) = not expandable && go n e && ok r + go n (Let (Rec prs) e) = not expandable && go n e && all (ok . snd) prs -- Case: see Note [Case expressions are work-free] -- App, Let: see Note [Arguments and let-bindings exprIsCheapX] +-------------------- +exprIsWorkFree :: CoreExpr -> Bool +-- See Note [exprIsWorkFree] +exprIsWorkFree e = exprIsCheapX isWorkFreeApp False e -{- Note [exprIsExpandable] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -An expression is "expandable" if we are willing to duplicate it, if doing -so might make a RULE or case-of-constructor fire. Consider - let x = (a,b) - y = build g - in ....(case x of (p,q) -> rhs)....(foldr k z y).... - -We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold), -but we do want - - * the case-expression to simplify - (via exprIsConApp_maybe, exprIsLiteral_maybe) - - * the foldr/build RULE to fire - (by expanding the unfolding during rule matching) - -So we classify the unfolding of a let-binding as "expandable" (via the -uf_expandable field) if we want to do this kind of on-the-fly -expansion. Specifically: - -* True of constructor applications (K a b) - -* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic. - (NB: exprIsCheap might not be true of this) - -* False of case-expressions. If we have - let x = case ... in ...(case x of ...)... - we won't simplify. We have to inline x. See #14688. - -* False of let-expressions (same reason); and in any case we - float lets out of an RHS if doing so will reveal an expandable - application (see SimplEnv.doFloatFromRhs). - -* Take care: exprIsExpandable should /not/ be true of primops. I - found this in test T5623a: - let q = /\a. Ptr a (a +# b) - in case q @ Float of Ptr v -> ...q... - - q's inlining should not be expandable, else exprIsConApp_maybe will - say that (q @ Float) expands to (Ptr a (a +# b)), and that will - duplicate the (a +# b) primop, which we should not do lightly. - (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) --} +-------------------- +exprIsCheap :: CoreExpr -> Bool +-- See Note [exprIsCheap] +exprIsCheap e = exprIsCheapX isCheapApp False e -------------------------------------- +-------------------- exprIsExpandable :: CoreExpr -> Bool -- See Note [exprIsExpandable] -exprIsExpandable e - = ok e - where - ok e = go 0 e - - -- n is the number of value arguments - go n (Var v) = isExpandableApp v n - go _ (Lit {}) = True - go _ (Type {}) = True - go _ (Coercion {}) = True - go n (Cast e _) = go n e - go n (Tick t e) | tickishCounts t = False - | otherwise = go n e - go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e - | otherwise = go n e - go n (App f e) | isRuntimeArg e = go (n+1) f && ok e - | otherwise = go n f - go _ (Case {}) = False - go _ (Let {}) = False - - -------------------------------------- -type CheapAppFun = Id -> Arity -> Bool - -- Is an application of this function to n *value* args - -- always cheap, assuming the arguments are cheap? - -- True mainly of data constructors, partial applications; - -- but with minor variations: - -- isWorkFreeApp - -- isCheapApp +exprIsExpandable e = exprIsCheapX isExpandableApp True e isWorkFreeApp :: CheapAppFun isWorkFreeApp fn n_val_args @@ -1352,7 +1293,7 @@ isCheapApp fn n_val_args | isDeadEndId fn = True -- See Note [isCheapApp: bottoming functions] | otherwise = case idDetails fn of - DataConWorkId {} -> True -- Actually handled by isWorkFreeApp + -- DataConWorkId {} -> _ -- Handled by isWorkFreeApp RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId op _ -> primOpIsCheap op @@ -1367,6 +1308,7 @@ isExpandableApp fn n_val_args | isWorkFreeApp fn n_val_args = True | otherwise = case idDetails fn of + -- DataConWorkId {} -> _ -- Handled by isWorkFreeApp RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId {} -> False @@ -1398,6 +1340,50 @@ isExpandableApp fn n_val_args I'm not sure why we have a special case for bottoming functions in isCheapApp. Maybe we don't need it. +Note [exprIsExpandable] +~~~~~~~~~~~~~~~~~~~~~~~ +An expression is "expandable" if we are willing to duplicate it, if doing +so might make a RULE or case-of-constructor fire. Consider + let x = (a,b) + y = build g + in ....(case x of (p,q) -> rhs)....(foldr k z y).... + +We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold), +but we do want + + * the case-expression to simplify + (via exprIsConApp_maybe, exprIsLiteral_maybe) + + * the foldr/build RULE to fire + (by expanding the unfolding during rule matching) + +So we classify the unfolding of a let-binding as "expandable" (via the +uf_expandable field) if we want to do this kind of on-the-fly +expansion. Specifically: + +* True of constructor applications (K a b) + +* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic. + (NB: exprIsCheap might not be true of this) + +* False of case-expressions. If we have + let x = case ... in ...(case x of ...)... + we won't simplify. We have to inline x. See #14688. + +* False of let-expressions (same reason); and in any case we + float lets out of an RHS if doing so will reveal an expandable + application (see SimplEnv.doFloatFromRhs). + +* Take care: exprIsExpandable should /not/ be true of primops. I + found this in test T5623a: + let q = /\a. Ptr a (a +# b) + in case q @ Float of Ptr v -> ...q... + + q's inlining should not be expandable, else exprIsConApp_maybe will + say that (q @ Float) expands to (Ptr a (a +# b)), and that will + duplicate the (a +# b) primop, which we should not do lightly. + (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) + Note [isExpandableApp: bottoming functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important that isExpandableApp does not respond True to bottoming @@ -1541,10 +1527,10 @@ expr_ok fun_ok primop_ok (Case scrut bndr _ alts) && altsAreExhaustive alts expr_ok fun_ok primop_ok other_expr - | (expr, args) <- collectArgs other_expr + | (expr, val_args) <- collectValArgs other_expr = case stripTicksTopE (not . tickishCounts) expr of Var f -> - app_ok fun_ok primop_ok f args + app_ok fun_ok primop_ok f val_args -- 'LitRubbish' is the only literal that can occur in the head of an -- application and will not be matched by the above case (Var /= Lit). @@ -1558,8 +1544,8 @@ expr_ok fun_ok primop_ok other_expr _ -> False ----------------------------- -app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool -app_ok fun_ok primop_ok fun args +app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreArg] -> Bool +app_ok fun_ok primop_ok fun val_args | not (fun_ok fun) = False -- This code path is only taken for Note [Speculative evaluation] | otherwise @@ -1568,21 +1554,22 @@ app_ok fun_ok primop_ok fun args -- DFuns terminate, unless the dict is implemented -- with a newtype in which case they may not - DataConWorkId {} -> True - -- The strictness of the constructor has already - -- been expressed by its "wrapper", so we don't need - -- to take the arguments into account + DataConWorkId dc + | Just str_marks <- dataConRepStrictness_maybe dc + -> all3Prefix field_ok str_marks val_arg_tys val_args + | otherwise + -> all2Prefix arg_ok val_arg_tys val_args ClassOpId _ is_terminating_result | is_terminating_result -- See Note [exprOkForSpeculation and type classes] - -> assertPpr (n_val_args == 1) (ppr fun $$ ppr args) $ + -> assertPpr (n_val_args == 1) (ppr fun $$ ppr val_args) $ True -- assert: terminating result type => can't be applied; -- c.f the _other case below PrimOpId op _ | primOpIsDiv op - , [arg1, Lit lit] <- args + , [arg1, Lit lit] <- val_args -> not (isZeroLit lit) && expr_ok fun_ok primop_ok arg1 -- Special case for dividing operations that fail -- In general they are NOT ok-for-speculation @@ -1600,13 +1587,13 @@ app_ok fun_ok primop_ok fun args | otherwise -> primop_ok op -- Check the primop itself - && and (zipWith arg_ok arg_tys args) -- Check the arguments + && all2Prefix arg_ok val_arg_tys val_args -- Check the arguments _other -- Unlifted and terminating types; -- Also c.f. the Var case of exprIsHNF | isTerminatingType fun_ty -- See Note [exprOkForSpeculation and type classes] || definitelyUnliftedType fun_ty - -> assertPpr (n_val_args == 0) (ppr fun $$ ppr args) + -> assertPpr (n_val_args == 0) (ppr fun $$ ppr val_args) True -- Both terminating types (e.g. Eq a), and unlifted types (e.g. Int#) -- are non-functions and so will have no value args. The assert is -- just to check this. @@ -1615,7 +1602,7 @@ app_ok fun_ok primop_ok fun args -- Partial applications | idArity fun > n_val_args -> - and (zipWith arg_ok arg_tys args) -- Check the arguments + all2Prefix arg_ok val_arg_tys val_args -- Check the arguments -- Functions that terminate fast without raising exceptions etc -- See Note [Discarding unnecessary unsafeEqualityProofs] @@ -1627,18 +1614,27 @@ app_ok fun_ok primop_ok fun args -- see Note [exprOkForSpeculation and evaluated variables] where fun_ty = idType fun - n_val_args = valArgCount args + n_val_args = length val_args (arg_tys, _) = splitPiTys fun_ty + val_arg_tys = mapMaybe anonPiTyBinderType_maybe arg_tys -- Used for arguments to primops and to partial applications - arg_ok :: PiTyVarBinder -> CoreExpr -> Bool - arg_ok (Named _) _ = True -- A type argument - arg_ok (Anon ty _) arg -- A term argument - | definitelyLiftedType (scaledThing ty) + arg_ok :: Type -> CoreExpr -> Bool + arg_ok ty arg + | definitelyLiftedType ty = True -- See Note [Primops with lifted arguments] | otherwise = expr_ok fun_ok primop_ok arg + -- Used for DataCon worker arguments + field_ok :: StrictnessMark -> Type -> CoreExpr -> Bool + field_ok str ty arg -- A term argument + | NotMarkedStrict <- str -- iff it's a lazy field + , definitelyLiftedType ty -- and its type is lifted + = True -- then the worker app does not eval + | otherwise + = expr_ok fun_ok primop_ok arg + ----------------------------- altsAreExhaustive :: [Alt b] -> Bool -- True <=> the case alternatives are definitely exhaustive @@ -1905,12 +1901,14 @@ exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding -- or PAPs. -- exprIsHNFlike :: HasDebugCallStack => (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool -exprIsHNFlike is_con is_con_unf = is_hnf_like +exprIsHNFlike is_con is_con_unf e + = -- pprTraceWith "hnf" (\r -> ppr r <+> ppr e) $ + is_hnf_like e where is_hnf_like (Var v) -- NB: There are no value args at this point - = id_app_is_value v 0 -- Catches nullary constructors, - -- so that [] and () are values, for example - -- and (e.g.) primops that don't have unfoldings + = id_app_is_value v [] -- Catches nullary constructors, + -- so that [] and () are values, for example + -- and (e.g.) primops that don't have unfoldings || is_con_unf (idUnfolding v) -- Check the thing's unfolding; it might be bound to a value -- or to a guaranteed-evaluated variable (isEvaldUnfolding) @@ -1934,31 +1932,57 @@ exprIsHNFlike is_con is_con_unf = is_hnf_like -- See Note [exprIsHNF Tick] is_hnf_like (Cast e _) = is_hnf_like e is_hnf_like (App e a) - | isValArg a = app_is_value e 1 + | isValArg a = app_is_value e [a] | otherwise = is_hnf_like e is_hnf_like (Let _ e) = is_hnf_like e -- Lazy let(rec)s don't affect us is_hnf_like _ = False - -- 'n' is the number of value args to which the expression is applied - -- And n>0: there is at least one value argument - app_is_value :: CoreExpr -> Int -> Bool - app_is_value (Var f) nva = id_app_is_value f nva - app_is_value (Tick _ f) nva = app_is_value f nva - app_is_value (Cast f _) nva = app_is_value f nva - app_is_value (App f a) nva - | isValArg a = - app_is_value f (nva + 1) && - not (needsCaseBinding (exprType a) a) - -- For example f (x /# y) where f has arity two, and the first - -- argument is unboxed. This is not a value! - -- But f 34# is a value. - -- NB: Check app_is_value first, the arity check is cheaper - | otherwise = app_is_value f nva - app_is_value _ _ = False - - id_app_is_value id n_val_args - = is_con id - || idArity id > n_val_args + -- Collect arguments through Casts and Ticks and call id_app_is_value + app_is_value :: CoreExpr -> [CoreArg] -> Bool + app_is_value (Var f) as = id_app_is_value f as + app_is_value (Tick _ f) as = app_is_value f as + app_is_value (Cast f _) as = app_is_value f as + app_is_value (App f a) as | isValArg a = app_is_value f (a:as) + | otherwise = app_is_value f as + app_is_value _ _ = False + + id_app_is_value id val_args + -- First handle saturated applications of DataCons with strict fields + | Just dc <- isDataConWorkId_maybe id -- DataCon + , Just str_marks <- dataConRepStrictness_maybe dc -- with strict fields + , assert (val_args `leLength` str_marks) True + , val_args `equalLength` str_marks -- in a saturated app + = all3Prefix check_field str_marks val_arg_tys val_args + + -- Now all applications except saturated DataCon apps with strict fields + | idArity id > length val_args + -- PAP: Check unlifted val_args + || is_con id && isNothing (isDataConWorkId_maybe id >>= dataConRepStrictness_maybe) + -- Either a lazy DataCon or a CONLIKE. + -- Hence we only need to check unlifted val_args here. + -- NB: We assume that CONLIKEs are lazy, which is their entire + -- point. + = all2Prefix check_arg val_arg_tys val_args + + | otherwise + = False + where + fun_ty = idType id + (arg_tys,_) = splitPiTys fun_ty + val_arg_tys = mapMaybe anonPiTyBinderType_maybe arg_tys + -- val_arg_tys = map exprType val_args, but much less costly. + -- The obvious definition regresses T16577 by 30% so we don't do it. + + check_arg a_ty a = mightBeUnliftedType a_ty ==> is_hnf_like a + -- Check unliftedness; for example f (x /# 12#) where f has arity two, + -- and the first argument is unboxed. This is not a value! + -- But f 34# is a value, so check args for HNFs. + -- NB: We check arity (and CONLIKEness) first because it's cheaper + -- and we reject quickly on saturated apps. + check_field str a_ty a + = isMarkedStrict str || mightBeUnliftedType a_ty ==> is_hnf_like a + a ==> b = not a || b + infixr 1 ==> {- Note [exprIsHNF Tick] @@ -2520,7 +2544,7 @@ This means the seqs on x and y both become no-ops and compared to the first vers The downside is that the caller of $wfoo potentially has to evaluate `y` once if we can't prove it isn't already evaluated. But y coming out of a strict field is in WHNF so safe to evaluated. And most of the time it will be properly tagged+evaluated -already at the call site because of the Strict Field Invariant! See Note [Strict Field Invariant] for more in this. +already at the call site because of the Strict Field Invariant! See Note [STG Strict Field Invariant] for more in this. This makes GHC itself around 1% faster despite doing slightly more work! So this is generally quite good. We only apply this when we think there is a benefit in doing so however. There are a number of cases in which ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -64,8 +64,8 @@ With nofib being ~0.3% faster as well. See Note [Tag inference passes] for how we proceed to generate and use this information. -Note [Strict Field Invariant] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [STG Strict Field Invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As part of tag inference we introduce the Strict Field Invariant. Which consists of us saying that: @@ -124,15 +124,33 @@ Note that there are similar constraints around Note [CBV Function Ids]. Note [How untagged pointers can end up in strict fields] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Since the resolution of #20749 where Core passes assume that DataCon workers +evaluate their strict fields, it is pretty simple to see how the Simplifier +might exploit that knowledge to drop evals. Example: + + data MkT a = MkT !a + f :: [Int] -> T [Int] + f xs = xs `seq` MkT xs + +in Core we will have + + f = \xs -> MkT @[Int] xs + +No eval left there. + Consider data Set a = Tip | Bin !a (Set a) (Set a) We make a wrapper for Bin that evaluates its arguments $WBin x a b = case x of xv -> Bin xv a b Here `xv` will always be evaluated and properly tagged, just as the -Strict Field Invariant requires. +Note [STG Strict Field Invariant] requires. + +But alas, the Simplifier can destroy the invariant: see #15696. +Indeed, as Note [Strict fields in Core] explains, Core passes +assume that Data constructor workers evaluate their strict fields, +so the Simplifier will drop seqs freely. -But alas the Simplifier can destroy the invariant: see #15696. We start with thk = f () g x = ...(case thk of xv -> Bin xv Tip Tip)... @@ -153,7 +171,7 @@ Now you can see that the argument of Bin, namely thk, points to the thunk, not to the value as it did before. In short, although it may be rare, the output of optimisation passes -cannot guarantee to obey the Strict Field Invariant. For this reason +cannot guarantee to obey the Note [STG Strict Field Invariant]. For this reason we run tag inference. See Note [Tag inference passes]. Note [Tag inference passes] @@ -163,7 +181,7 @@ Tag inference proceeds in two passes: The result is then attached to /binders/. This is implemented by `inferTagsAnal` in GHC.Stg.InferTags * The second pass walks over the AST checking if the Strict Field Invariant is upheld. - See Note [Strict Field Invariant]. + See Note [STG Strict Field Invariant]. If required this pass modifies the program to uphold this invariant. Tag information is also moved from /binders/ to /occurrences/ during this pass. This is done by `GHC.Stg.InferTags.Rewrite (rewriteTopBinds)`. ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -64,7 +64,7 @@ The work of this pass is simple: * For any strict field we check if the argument is known to be properly tagged. * If it's not known to be properly tagged, we wrap the whole thing in a case, which will force the argument before allocation. -This is described in detail in Note [Strict Field Invariant]. +This is described in detail in Note [STG Strict Field Invariant]. The only slight complication is that we have to make sure not to invalidate free variable analysis in the process. @@ -217,7 +217,7 @@ When compiling bytecode we call myCoreToStg to get STG code first. myCoreToStg in turn calls out to stg2stg which runs the STG to STG passes followed by free variables analysis and the tag inference pass including it's rewriting phase at the end. -Running tag inference is important as it upholds Note [Strict Field Invariant]. +Running tag inference is important as it upholds Note [STG Strict Field Invariant]. While code executed by GHCi doesn't take advantage of the SFI it can call into compiled code which does. So it must still make sure that the SFI is upheld. See also #21083 and #22042. ===================================== compiler/GHC/Tc/TyCl/Build.hs ===================================== @@ -176,12 +176,13 @@ buildDataCon fam_envs dc_bang_opts src_name declared_infix prom_info src_bangs tag = lookupNameEnv_NF tag_map src_name -- See Note [Constructor tag allocation], fixes #14657 data_con = mkDataCon src_name declared_infix prom_info - src_bangs field_lbls + src_bangs impl_bangs str_marks field_lbls univ_tvs ex_tvs user_tvbs eq_spec ctxt arg_tys res_ty NoPromInfo rep_tycon tag stupid_ctxt dc_wrk dc_rep dc_wrk = mkDataConWorkId work_name data_con - dc_rep = initUs_ us (mkDataConRep dc_bang_opts fam_envs wrap_name data_con) + (dc_rep, impl_bangs, str_marks) = + initUs_ us (mkDataConRep dc_bang_opts fam_envs wrap_name data_con) ; traceIf (text "buildDataCon 2" <+> ppr src_name) ; return data_con } ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -1390,33 +1390,8 @@ arguments. That is the job of dmdTransformDataConSig. More precisely, * it returns the demands on the arguments; in the above example that is [SL, A] -Nasty wrinkle. Consider this code (#22475 has more realistic examples but -assume this is what the demand analyser sees) - - data T = MkT !Int Bool - get :: T -> Bool - get (MkT _ b) = b - - foo = let v::Int = I# 7 - t::T = MkT v True - in get t - -Now `v` is unused by `get`, /but/ we can't give `v` an Absent demand, -else we'll drop the binding and replace it with an error thunk. -Then the code generator (more specifically GHC.Stg.InferTags.Rewrite) -will add an extra eval of MkT's argument to give - foo = let v::Int = error "absent" - t::T = case v of v' -> MkT v' True - in get t - -Boo! Because of this extra eval (added in STG-land), the truth is that `MkT` -may (or may not) evaluate its arguments (as established in #21497). Hence the -use of `bump` in dmdTransformDataConSig, which adds in a `C_01` eval. The -`C_01` says "may or may not evaluate" which is absolutely faithful to what -InferTags.Rewrite does. - -In particular it is very important /not/ to make that a `C_11` eval, -see Note [Data-con worker strictness]. +When the data constructor worker has strict fields, they act as additional +seqs; hence we add an additional `C_11` eval. -} {- ********************************************************************* @@ -1616,6 +1591,29 @@ a bad fit because expression may not throw a precise exception (increasing precision of the analysis), but that's just a favourable guess. +Note [Side-effects and strictness] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Due to historic reasons and the continued effort not to cause performance +regressions downstream, Strictness Analysis is currently prone to discarding +observable side-effects (other than precise exceptions, see +Note [Precise exceptions and strictness analysis]) in some cases. For example, + f :: MVar () -> Int -> IO Int + f mv x = putMVar mv () >> (x `seq` return x) +The call to `putMVar` is an observable side-effect. Yet, Strictness Analysis +currently concludes that `f` is strict in `x` and uses call-by-value. +That means `f mv (error "boom")` will error out with the imprecise exception +rather performing the side-effect. + +This is a conscious violation of the semantics described in the paper +"a semantics for imprecise exceptions"; so it would be great if we could +identify the offending primops and extend the idea in +Note [Which scrutinees may throw precise exceptions] to general side-effects. + +Unfortunately, the existing has-side-effects classification for primops is +too conservative, listing `writeMutVar#` and even `readMutVar#` as +side-effecting. That is due to #3207. A possible way forward is described in +#17900, but no effort has been so far towards a resolution. + Note [Exceptions and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We used to smart about catching exceptions, but we aren't anymore. @@ -2326,7 +2324,7 @@ dmdTransformDataConSig str_marks sd = case viewProd arity body_sd of mk_body_ty n dmds = DmdType emptyDmdEnv (zipWith (bump n) str_marks dmds) topDiv bump n str dmd | isMarkedStrict str = multDmd n (plusDmd str_field_dmd dmd) | otherwise = multDmd n dmd - str_field_dmd = C_01 :* seqSubDmd -- Why not C_11? See Note [Data-con worker strictness] + str_field_dmd = C_11 :* seqSubDmd -- See Note [Strict fields in Core] -- | A special 'DmdTransformer' for dictionary selectors that feeds the demand -- on the result into the indicated dictionary component (if saturated). ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -220,7 +220,7 @@ The invariants around the arguments of call by value function like Ids are then: * Any `WorkerLikeId` * Some `JoinId` bindings. -This works analogous to the Strict Field Invariant. See also Note [Strict Field Invariant]. +This works analogous to the Strict Field Invariant. See also Note [STG Strict Field Invariant]. To make this work what we do is: * During W/W and SpecConstr any worker/specialized binding we introduce ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -56,7 +56,7 @@ import GHC.Core.Coercion import GHC.Core.Reduction import GHC.Core.Make import GHC.Core.FVs ( mkRuleInfo ) -import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, coreAltsType ) +import GHC.Core.Utils ( exprType, mkCast, coreAltsType ) import GHC.Core.Unfold.Make import GHC.Core.SimpleOpt import GHC.Core.TyCon @@ -586,8 +586,12 @@ mkDataConWorkId wkr_name data_con = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info where - tycon = dataConTyCon data_con -- The representation TyCon - wkr_ty = dataConRepType data_con + tycon = dataConTyCon data_con -- The representation TyCon + wkr_ty = dataConRepType data_con + univ_tvs = dataConUnivTyVars data_con + ex_tcvs = dataConExTyCoVars data_con + arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys + str_marks = dataConRepStrictness data_con ----------- Workers for data types -------------- alg_wkr_info = noCafIdInfo @@ -595,15 +599,19 @@ mkDataConWorkId wkr_name data_con `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 - -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon + `setDmdSigInfo` wkr_sig + -- Workers eval their strict fields + -- See Note [Strict fields in Core] wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + wkr_sig = mkClosedDmdSig wkr_dmds topDiv + wkr_dmds = map mk_dmd str_marks + mk_dmd MarkedStrict = evalDmd + mk_dmd NotMarkedStrict = topDmd + ----------- Workers for newtypes -------------- - univ_tvs = dataConUnivTyVars data_con - ex_tcvs = dataConExTyCoVars data_con - arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` dataConWrapperInlinePragma @@ -686,10 +694,10 @@ mkDataConRep :: DataConBangOpts -> FamInstEnvs -> Name -> DataCon - -> UniqSM DataConRep + -> UniqSM (DataConRep, [HsImplBang], [StrictnessMark]) mkDataConRep dc_bang_opts fam_envs wrap_name data_con | not wrapper_reqd - = return NoDataConRep + = return (NoDataConRep, arg_ibangs, rep_strs) | otherwise = do { wrap_args <- mapM (newLocal (fsLit "conrep")) wrap_arg_tys @@ -744,11 +752,8 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con ; return (DCR { dcr_wrap_id = wrap_id , dcr_boxer = mk_boxer boxers - , dcr_arg_tys = rep_tys - , dcr_stricts = rep_strs - -- For newtypes, dcr_bangs is always [HsLazy]. - -- See Note [HsImplBangs for newtypes]. - , dcr_bangs = arg_ibangs }) } + , dcr_arg_tys = rep_tys } + , arg_ibangs, rep_strs) } where (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty) @@ -793,8 +798,8 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con (not new_tycon -- (Most) newtypes have only a worker, with the exception -- of some newtypes written with GADT syntax. See below. - && (any isBanged (ev_ibangs ++ arg_ibangs))) - -- Some forcing/unboxing (includes eq_spec) + && (any isUnpacked (ev_ibangs ++ arg_ibangs))) + -- Some unboxing (includes eq_spec) || isFamInstTyCon tycon -- Cast result || dataConUserTyVarsNeedWrapper data_con -- If the data type was written with GADT syntax and @@ -1057,7 +1062,7 @@ dataConArgRep arg_ty HsLazy = ([(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer)) dataConArgRep arg_ty (HsStrict _) - = ([(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer)) + = ([(arg_ty, MarkedStrict)], (unitUnboxer, unitBoxer)) -- Seqs are inserted in STG dataConArgRep arg_ty (HsUnpack Nothing) = dataConArgUnpack arg_ty @@ -1087,9 +1092,6 @@ wrapCo co rep_ty (unbox_rep, box_rep) -- co :: arg_ty ~ rep_ty ; return (rep_ids, rep_expr `Cast` mkSymCo sco) } ------------------------ -seqUnboxer :: Unboxer -seqUnboxer v = return ([v], mkDefaultCase (Var v) v) - unitUnboxer :: Unboxer unitUnboxer v = return ([v], \e -> e) ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Utils.Misc ( dropWhileEndLE, spanEnd, last2, lastMaybe, onJust, - List.foldl1', foldl2, count, countWhile, all2, + List.foldl1', foldl2, count, countWhile, all2, all2Prefix, all3Prefix, lengthExceeds, lengthIs, lengthIsNot, lengthAtLeast, lengthAtMost, lengthLessThan, @@ -646,6 +646,25 @@ all2 _ [] [] = True all2 p (x:xs) (y:ys) = p x y && all2 p xs ys all2 _ _ _ = False +all2Prefix :: (a -> b -> Bool) -> [a] -> [b] -> Bool +-- ^ `all2Prefix p xs ys` is a fused version of `and $ zipWith2 p xs ys`. +-- So if one list is shorter than the other, `p` is assumed to be `True` for the +-- suffix. +all2Prefix p xs ys = go xs ys + where go (x:xs) (y:ys) = p x y && go xs ys + go _ _ = True +{-# INLINABLE all2Prefix #-} + +all3Prefix :: (a -> b -> c -> Bool) -> [a] -> [b] -> [c] -> Bool +-- ^ `all3Prefix p xs ys zs` is a fused version of `and $ zipWith3 p xs ys zs`. +-- So if one list is shorter than the others, `p` is assumed to be `True` for +-- the suffix. +all3Prefix p xs ys zs = go xs ys zs + where + go (x:xs) (y:ys) (z:zs) = p x y z && go xs ys zs + go _ _ _ = True +{-# INLINABLE all3Prefix #-} + -- Count the number of times a predicate is true count :: (a -> Bool) -> [a] -> Int ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -17,6 +17,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: Class op . (BUILTIN) @@ -25,6 +27,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Arrow (BUILTIN) Rule fired: Class op $p1Arrow (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) @@ -38,6 +42,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op first (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op >>= (BUILTIN) @@ -48,6 +54,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @(_, ()) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: Class op . (BUILTIN) @@ -56,6 +64,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op . (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op $p1Applicative (BUILTIN) @@ -70,6 +80,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Arrow (BUILTIN) Rule fired: Class op $p1Arrow (BUILTIN) Rule fired: Class op id (BUILTIN) @@ -83,6 +95,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op ||| (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op $p1Applicative (BUILTIN) @@ -98,6 +112,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: Class op . (BUILTIN) @@ -108,22 +124,6 @@ Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: mkRule @((), _) (T18013a) Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @(_, ()) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) Rule fired: mkRule @(_, ()) (T18013a) Rule fired: Class op fmap (BUILTIN) Rule fired: mkRule @(_, ()) (T18013a) @@ -138,9 +138,9 @@ mapMaybeRule [InlPrag=[2]] :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, Arity=1, - Str=<1!P(L,LC(S,C(1,C(1,P(L,1L)))))>, - Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, + Str=<1!P(SL,LC(S,C(1,C(1,P(L,1L)))))>, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@b) (f [Occ=Once1!] :: Rule IO a b) -> case f of { Rule @s ww ww1 [Occ=OnceL1!] -> @@ -219,36 +219,41 @@ mapMaybeRule -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18013.$trModule4 :: GHC.Prim.Addr# [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 20 0}] T18013.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T18013.$trModule3 :: GHC.Types.TrName [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T18013.$trModule3 = GHC.Types.TrNameS T18013.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18013.$trModule2 :: GHC.Prim.Addr# [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 30 0}] T18013.$trModule2 = "T18013"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T18013.$trModule1 :: GHC.Types.TrName [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T18013.$trModule1 = GHC.Types.TrNameS T18013.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T18013.$trModule :: GHC.Types.Module [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T18013.$trModule = GHC.Types.Module T18013.$trModule3 T18013.$trModule1 ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -417,7 +417,10 @@ test('T21391', normal, compile, ['-O -dcore-lint']) test('T22112', normal, compile, ['-O -dsuppress-uniques -dno-typeable-binds -ddump-simpl']) test('T21391a', normal, compile, ['-O -dcore-lint']) # We don't want to see a thunk allocation for the insertBy expression after CorePrep. -test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]'), expect_broken(21392) ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques']) +# Unfortunately, this test is no longer broken after we made workers strict in strict fields, +# so it is no longer a reproducer for T21392. Still, it doesn't hurt if we test that we don't +# regress again. +test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]') ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques']) test('T21689', [extra_files(['T21689a.hs'])], multimod_compile, ['T21689', '-v0 -O']) test('T21801', normal, compile, ['-O -dcore-lint']) test('T21848', [grep_errmsg(r'SPEC wombat') ], compile, ['-O -ddump-spec']) ===================================== testsuite/tests/stranal/sigs/T16859.stderr ===================================== @@ -4,7 +4,7 @@ T16859.bar: <1!A> T16859.baz: <1L><1!P(L)><1C(1,L)> T16859.buz: <1!P(L,L)> T16859.foo: <1L> -T16859.mkInternalName: <1!P(L)><1L><1L> +T16859.mkInternalName: <1!P(L)> T16859.n_loc: <1!P(A,A,A,1L)> T16859.n_occ: <1!P(A,1!P(L,L),A,A)> T16859.n_sort: <1!P(1L,A,A,A)> View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a759195932880101fb73350156212b3449d536b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a759195932880101fb73350156212b3449d536b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 15:30:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Mar 2023 10:30:51 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: hadrian: Add dependency from lib/settings to mk/config.mk Message-ID: <6400c12b809da_2100182e67fa6047667@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - c341f7b3 by Richard Eisenberg at 2023-03-02T10:30:35-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - e9d0cb5b by Matthew Pickering at 2023-03-02T10:30:36-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - a44834b1 by Zubin Duggal at 2023-03-02T10:30:37-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 25 changed files: - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Constraint.hs - hadrian/bindist/Makefile - libraries/base/GHC/List.hs - + testsuite/tests/codeGen/should_compile/T23002.hs - testsuite/tests/codeGen/should_compile/all.T - + testsuite/tests/numeric/should_compile/T23019.hs - testsuite/tests/numeric/should_compile/all.T - + testsuite/tests/patsyn/should_compile/T23038.hs - + testsuite/tests/patsyn/should_compile/T23038.stderr - testsuite/tests/patsyn/should_compile/all.T - testsuite/tests/perf/should_run/T18964.hs - + testsuite/tests/perf/should_run/T23021.hs - + testsuite/tests/perf/should_run/T23021.stdout - testsuite/tests/perf/should_run/all.T - + testsuite/tests/th/T23036.hs - + testsuite/tests/th/T23036.stderr - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_fail/T22707.hs - + testsuite/tests/typecheck/should_fail/T22707.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -73,6 +73,7 @@ regUsageOfInstr :: Platform -> Instr -> RegUsage regUsageOfInstr platform instr = case instr of ANN _ i -> regUsageOfInstr platform i COMMENT{} -> usage ([], []) + MULTILINE_COMMENT{} -> usage ([], []) PUSH_STACK_FRAME -> usage ([], []) POP_STACK_FRAME -> usage ([], []) DELTA{} -> usage ([], []) @@ -207,11 +208,12 @@ callerSavedRegisters patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr patchRegsOfInstr instr env = case instr of -- 0. Meta Instructions - ANN d i -> ANN d (patchRegsOfInstr i env) - COMMENT{} -> instr - PUSH_STACK_FRAME -> instr - POP_STACK_FRAME -> instr - DELTA{} -> instr + ANN d i -> ANN d (patchRegsOfInstr i env) + COMMENT{} -> instr + MULTILINE_COMMENT{} -> instr + PUSH_STACK_FRAME -> instr + POP_STACK_FRAME -> instr + DELTA{} -> instr -- 1. Arithmetic Instructions ---------------------------------------------- ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -1110,14 +1110,10 @@ doubleOp2 _ _ _ _ = Nothing -------------------------- doubleDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr doubleDecodeOp env (LitDouble ((decodeFloat . fromRational @Double) -> (m, e))) - = Just $ mkCoreUnboxedTuple [ Lit (mkLitINT64 (toInteger m)) + = Just $ mkCoreUnboxedTuple [ Lit (mkLitInt64Wrap (toInteger m)) , mkIntVal platform (toInteger e) ] where platform = roPlatform env - mkLitINT64 | platformWordSizeInBits platform < 64 - = mkLitInt64Wrap - | otherwise - = mkLitIntWrap platform doubleDecodeOp _ _ = Nothing ===================================== 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') } ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -476,30 +476,37 @@ mkErrorItem ct , ei_m_reason = m_reason , ei_suppress = suppress }} +-- | Actually report this 'ErrorItem'. +unsuppressErrorItem :: ErrorItem -> ErrorItem +unsuppressErrorItem ei = ei { ei_suppress = False } + ---------------------------------------------------------------- reportWanteds :: SolverReportErrCtxt -> TcLevel -> WantedConstraints -> TcM () reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics , wc_errors = errs }) | isEmptyWC wc = traceTc "reportWanteds empty WC" empty | otherwise - = do { tidy_items <- mapMaybeM mkErrorItem tidy_cts + = do { tidy_items1 <- mapMaybeM mkErrorItem tidy_cts ; traceTc "reportWanteds 1" (vcat [ text "Simples =" <+> ppr simples , text "Suppress =" <+> ppr (cec_suppress ctxt) , text "tidy_cts =" <+> ppr tidy_cts - , text "tidy_items =" <+> ppr tidy_items + , text "tidy_items1 =" <+> ppr tidy_items1 , text "tidy_errs =" <+> ppr tidy_errs ]) - -- This check makes sure that we aren't suppressing the only error that will - -- actually stop compilation - ; assertPprM - ( do { errs_already <- ifErrsM (return True) (return False) - ; return $ - errs_already || -- we already reported an error (perhaps from an outer implication) - null simples || -- no errors to report here - any ignoreConstraint simples || -- one error is ignorable (is reported elsewhere) - not (all ei_suppress tidy_items) -- not all errors are suppressed - } ) - (vcat [text "reportWanteds is suppressing all errors"]) + -- Catch an awkward case in which /all/ errors are suppressed: + -- see Wrinkle at end of Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint + -- Unless we are sure that an error will be reported some other way (details + -- in the defn of tidy_items) un-suppress the lot. This makes sure we don't forget to + -- report an error at all, which is catastrophic: GHC proceeds to desguar and optimise + -- the program, even though it is full of type errors (#22702, #22793) + ; errs_already <- ifErrsM (return True) (return False) + ; let tidy_items + | not errs_already -- Have not already reported an error (perhaps + -- from an outer implication); see #21405 + , not (any ignoreConstraint simples) -- No error is ignorable (is reported elsewhere) + , all ei_suppress tidy_items1 -- All errors are suppressed + = map unsuppressErrorItem tidy_items1 + | otherwise = tidy_items1 -- First, deal with any out-of-scope errors: ; let (out_of_scope, other_holes, not_conc_errs) = partition_errors tidy_errs ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -903,19 +903,30 @@ mkOneRecordSelector all_cons idDetails fl has_sel con1 = assert (not (null cons_w_field)) $ head cons_w_field -- Selector type; Note [Polymorphic selectors] - field_ty = conLikeFieldType con1 lbl - data_tv_set = tyCoVarsOfTypes (data_ty : req_theta) - data_tvbs = filter (\tvb -> binderVar tvb `elemVarSet` data_tv_set) $ - conLikeUserTyVarBinders con1 + (univ_tvs, _, _, _, req_theta, _, data_ty) = conLikeFullSig con1 + + field_ty = conLikeFieldType con1 lbl + field_ty_tvs = tyCoVarsOfType field_ty + data_ty_tvs = tyCoVarsOfType data_ty + sel_tvs = field_ty_tvs `unionVarSet` data_ty_tvs + sel_tvbs = filter (\tvb -> binderVar tvb `elemVarSet` sel_tvs) $ + conLikeUserTyVarBinders con1 -- is_naughty: see Note [Naughty record selectors] - is_naughty = not (tyCoVarsOfType field_ty `subVarSet` data_tv_set) - || has_sel == NoFieldSelectors -- No field selectors => all are naughty - -- thus suppressing making a binding - -- A slight hack! + is_naughty = not ok_scoping || no_selectors + ok_scoping = case con1 of + RealDataCon {} -> field_ty_tvs `subVarSet` data_ty_tvs + PatSynCon {} -> field_ty_tvs `subVarSet` mkVarSet univ_tvs + -- In the PatSynCon case, the selector type is (data_ty -> field_ty), but + -- fvs(data_ty) are all universals (see Note [Pattern synonym result type] in + -- GHC.Core.PatSyn, so no need to check them. + + no_selectors = has_sel == NoFieldSelectors -- No field selectors => all are naughty + -- thus suppressing making a binding + -- A slight hack! sel_ty | is_naughty = unitTy -- See Note [Naughty record selectors] - | otherwise = mkForAllTys (tyVarSpecToBinders data_tvbs) $ + | otherwise = mkForAllTys (tyVarSpecToBinders sel_tvbs) $ -- Urgh! See Note [The stupid context] in GHC.Core.DataCon mkPhiTy (conLikeStupidTheta con1) $ -- req_theta is empty for normal DataCon @@ -926,7 +937,7 @@ mkOneRecordSelector all_cons idDetails fl has_sel -- fields in all the constructor have multiplicity Many. field_ty - -- Make the binding: sel (C2 { fld = x }) = x + -- make the binding: sel (C2 { fld = x }) = x -- sel (C7 { fld = x }) = x -- where cons_w_field = [C2,C7] sel_bind = mkTopFunBind Generated sel_lname alts @@ -976,8 +987,6 @@ mkOneRecordSelector all_cons idDetails fl has_sel where inst_tys = dataConResRepTyArgs dc - (_, _, _, _, req_theta, _, data_ty) = conLikeFullSig con1 - unit_rhs = mkLHsTupleExpr [] noExtField msg_lit = HsStringPrim NoSourceText (bytesFS (field_label lbl)) @@ -1036,36 +1045,42 @@ so that if the user tries to use 'x' as a selector we can bleat helpfully, rather than saying unhelpfully that 'x' is not in scope. Hence the sel_naughty flag, to identify record selectors that don't really exist. -In general, a field is "naughty" if its type mentions a type variable that -isn't in - * the (original, user-written) result type of the constructor, or - * the "required theta" for the constructor - -Note that this *allows* GADT record selectors (Note [GADT record -selectors]) whose types may look like sel :: T [a] -> a - -The "required theta" part is illustrated by test patsyn/should_run/records_run -where we have - - pattern ReadP :: Read a => a -> String - pattern ReadP {readp} <- (read -> readp) - -The selector is defined like this: - - $selreadp :: ReadP a => String -> a - $selReadP s = readp s - -Perfectly fine! The (ReadP a) constraint lets us contructor a value -of type 'a' from a bare String. NB: "required theta" is empty for -data cons (see conLikeFullSig), so this reasoning only bites for -patttern synonyms. - For naughty selectors we make a dummy binding sel = () so that the later type-check will add them to the environment, and they'll be exported. The function is never called, because the typechecker spots the sel_naughty field. +To determine naughtiness we distingish two cases: + +* For RealDataCons, a field is "naughty" if its type mentions a + type variable that isn't in the (original, user-written) result type + of the constructor. Note that this *allows* GADT record selectors + (Note [GADT record selectors]) whose types may look like sel :: T [a] -> a + +* For a PatSynCon, a field is "naughty" if its type mentions a type variable + that isn't in the universal type variables. + + This is a bit subtle. Consider test patsyn/should_run/records_run: + pattern ReadP :: forall a. ReadP a => a -> String + pattern ReadP {fld} <- (read -> readp) + The selector is defined like this: + $selReadPfld :: forall a. ReadP a => String -> a + $selReadPfld @a (d::ReadP a) s = readp @a d s + Perfectly fine! The (ReadP a) constraint lets us contruct a value of type + 'a' from a bare String. + + Another curious case (#23038): + pattern N :: forall a. () => forall. () => a -> Any + pattern N { fld } <- ( unsafeCoerce -> fld1 ) where N = unsafeCoerce + The selector looks like this + $selNfld :: forall a. Any -> a + $selNfld @a x = unsafeCoerce @Any @a x + Pretty strange (but used in the `cleff` package). + + TL;DR for pattern synonyms, the selector is OK if the field type mentions only + the universal type variables of the pattern synonym. + Note [NoFieldSelectors and naughty record selectors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Under NoFieldSelectors (see Note [NoFieldSelectors] in GHC.Rename.Env), record ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -2127,10 +2127,10 @@ uses GHC.Tc.Utils.anyUnfilledCoercionHoles to look through any filled coercion holes. The idea is that we wish to report the "root cause" -- the error that rewrote all the others. -Worry: It seems possible that *all* unsolved wanteds are rewritten by other -unsolved wanteds, so that e.g. w1 has w2 in its rewriter set, and w2 has -w1 in its rewiter set. We are unable to come up with an example of this in -practice, however, and so we believe this case cannot happen. +Wrinkle: In #22707, we have a case where all of the Wanteds have rewritten +each other. In order to report /some/ error in this case, we simply report +all the Wanteds. The user will get a perhaps-confusing error message, but +they've written a confusing program! Note [Avoiding rewriting cycles] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== 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)")' >> $@ ===================================== libraries/base/GHC/List.hs ===================================== @@ -886,23 +886,12 @@ takeWhileFB p c n = \x r -> if p x then x `c` r else n -- [] -- >>> dropWhile (< 0) [1,2,3] -- [1,2,3] -{-# NOINLINE [1] dropWhile #-} dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile _ [] = [] dropWhile p xs@(x:xs') | p x = dropWhile p xs' | otherwise = xs -{-# INLINE [0] dropWhileFB #-} -- See Note [Inline FB functions] -dropWhileFB :: (a -> Bool) -> (a -> b -> b) -> b -> a -> (Bool -> b) -> Bool -> b -dropWhileFB p c _n x xs = \drp -> if drp && p x then xs True else x `c` xs False - -{-# RULES -"dropWhile" [~1] forall p xs. dropWhile p xs = - build (\c n -> foldr (dropWhileFB p c n) (flipSeq n) xs True) -"dropWhileList" [1] forall p xs. foldr (dropWhileFB p (:) []) (flipSeq []) xs True = dropWhile p xs - #-} - -- | 'take' @n@, applied to a list @xs@, returns the prefix of @xs@ -- of length @n@, or @xs@ itself if @n >= 'length' xs at . -- @@ -998,31 +987,17 @@ drop n xs | n <= 0 = xs drop _ [] = [] drop n (_:xs) = drop (n-1) xs #else /* hack away */ -{-# INLINE[1] drop #-} -- Why [1]? See justification on take! => RULES +{-# INLINE drop #-} drop n ls | n <= 0 = ls | otherwise = unsafeDrop n ls - --- A version of drop that drops the whole list if given an argument --- less than 1 -{-# NOINLINE [0] unsafeDrop #-} -- See Note [Inline FB functions] -unsafeDrop :: Int -> [a] -> [a] -unsafeDrop !_ [] = [] -unsafeDrop 1 (_:xs) = xs -unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs - -{-# RULES -"drop" [~1] forall n xs . drop n xs = - build (\c nil -> if n <= 0 - then foldr c nil xs - else foldr (dropFB c nil) (flipSeq nil) xs n) -"unsafeDropList" [1] forall n xs . foldr (dropFB (:) []) (flipSeq []) xs n - = unsafeDrop n xs - #-} - -{-# INLINE [0] dropFB #-} -- See Note [Inline FB functions] -dropFB :: (a -> b -> b) -> b -> a -> (Int -> b) -> Int -> b -dropFB c _n x xs = \ m -> if m <= 0 then x `c` xs m else xs (m-1) + where + -- A version of drop that drops the whole list if given an argument + -- less than 1 + unsafeDrop :: Int -> [a] -> [a] + unsafeDrop !_ [] = [] + unsafeDrop 1 (_:xs) = xs + unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs #endif -- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of ===================================== testsuite/tests/codeGen/should_compile/T23002.hs ===================================== @@ -0,0 +1,257 @@ +module T23002 + (bfMakeKey, + bfEnc, + bfDec) where + +import Data.Array +import Data.Bits +import Data.Word +import Data.Char + +type Pbox = Array Word32 Word32 +type Sbox = Array Word32 Word32 + +data BF = BF Pbox Sbox Sbox Sbox Sbox + +bfEnc :: BF -> [Word32] -> [Word32] +bfEnc a b = aux a b 0 + where + aux :: BF -> [Word32] -> Word32 -> [Word32] + aux bs@(BF p s0 s1 s2 s3) (l:r:[]) 16 = (r `xor` p!17):(l `xor` p!16):[] + aux bs@(BF p s0 s1 s2 s3) (l:r:[]) i = aux bs (newr:newl:[]) (i+1) + where newl = l `xor` (p ! i) + newr = r `xor` (f newl) + f :: Word32 -> Word32 + f t = ((s0!a + s1!b) `xor` (s2 ! c)) + (s3 ! d) + where a = (t `shiftR` 24) + b = ((t `shiftL` 8) `shiftR` 24) + c = ((t `shiftL` 16) `shiftR` 24) + d = ((t `shiftL` 24) `shiftR` 24) + + +bfDec :: BF -> [Word32] -> [Word32] +bfDec (BF p s0 s1 s2 s3) a = bfEnc (BF (revP p) s0 s1 s2 s3) a + where revP :: Pbox -> Pbox + revP x = x//[(i, x ! (17-i)) | i <- [0..17]] + +bfMakeKey :: [Char] -> BF +bfMakeKey [] = procKey [0,0] (BF iPbox iSbox0 iSbox1 iSbox2 iSbox3) 0 +bfMakeKey k = procKey [0,0] (BF (string2Pbox k) iSbox0 iSbox1 iSbox2 iSbox3) 0 + +string2Pbox :: [Char] -> Pbox +string2Pbox k = array (0,17) [(fromIntegral i,xtext!!i) | i <- [0..17]] + where xtext = zipWith (xor) + (compress4 (doShift (makeTo72 (charsToWord32s k) 0) 0)) + [iPbox ! (fromIntegral i) | i <- [0..17]] + charsToWord32s [] = [] + charsToWord32s (k:ks) = (fromIntegral $ fromEnum k) : charsToWord32s ks + makeTo72 k 72 = [] + makeTo72 k i = k!!(i `mod` (length k)) : makeTo72 k (i+1) + doShift [] i = [] + doShift (w:ws) i = w `shiftL` (8*(3 - (i `mod` 4))) : doShift ws (i+1) + compress4 [] = [] + compress4 (a:b:c:d:etc) = (a .|. b .|. c .|. d) : compress4 etc + +procKey :: [Word32] -> BF -> Word32 -> BF +procKey (l:r:[]) tpbf@(BF p s0 s1 s2 s3) 1042 = tpbf +procKey (l:r:[]) tpbf@(BF p s0 s1 s2 s3) i = procKey [nl,nr] (newbf i) (i+2) + where [nl,nr] = bfEnc tpbf [l,r] + newbf x | x < 18 = (BF (p//[(x,nl),(x+1,nr)]) s0 s1 s2 s3) + | x < 274 = (BF p (s0//[(x-18,nl),(x-17,nr)]) s1 s2 s3) + | x < 530 = (BF p s0 (s1//[(x-274,nl),(x-273,nr)]) s2 s3) + | x < 786 = (BF p s0 s1 (s2//[(x-530,nl),(x-529,nr)]) s3) + | x < 1042 = (BF p s0 s1 s2 (s3//[(x-786,nl),(x-785,nr)])) + + + +---------- INITIAL S AND P BOXES ARE THE HEXADECIMAL DIGITS OF PI ------------ + +iPbox :: Pbox +iPbox = array (0,17) (zip [0..17] + [0x243f6a88, 0x85a308d3, 0x13198a2e, 0x03707344, 0xa4093822, 0x299f31d0, + 0x082efa98, 0xec4e6c89, 0x452821e6, 0x38d01377, 0xbe5466cf, 0x34e90c6c, + 0xc0ac29b7, 0xc97c50dd, 0x3f84d5b5, 0xb5470917, 0x9216d5d9, 0x8979fb1b]) + +iSbox0 :: Sbox +iSbox0 = array (0,255) (zip [0..255] + [0xd1310ba6, 0x98dfb5ac, 0x2ffd72db, 0xd01adfb7, 0xb8e1afed, 0x6a267e96, + 0xba7c9045, 0xf12c7f99, 0x24a19947, 0xb3916cf7, 0x0801f2e2, 0x858efc16, + 0x636920d8, 0x71574e69, 0xa458fea3, 0xf4933d7e, 0x0d95748f, 0x728eb658, + 0x718bcd58, 0x82154aee, 0x7b54a41d, 0xc25a59b5, 0x9c30d539, 0x2af26013, + 0xc5d1b023, 0x286085f0, 0xca417918, 0xb8db38ef, 0x8e79dcb0, 0x603a180e, + 0x6c9e0e8b, 0xb01e8a3e, 0xd71577c1, 0xbd314b27, 0x78af2fda, 0x55605c60, + 0xe65525f3, 0xaa55ab94, 0x57489862, 0x63e81440, 0x55ca396a, 0x2aab10b6, + 0xb4cc5c34, 0x1141e8ce, 0xa15486af, 0x7c72e993, 0xb3ee1411, 0x636fbc2a, + 0x2ba9c55d, 0x741831f6, 0xce5c3e16, 0x9b87931e, 0xafd6ba33, 0x6c24cf5c, + 0x7a325381, 0x28958677, 0x3b8f4898, 0x6b4bb9af, 0xc4bfe81b, 0x66282193, + 0x61d809cc, 0xfb21a991, 0x487cac60, 0x5dec8032, 0xef845d5d, 0xe98575b1, + 0xdc262302, 0xeb651b88, 0x23893e81, 0xd396acc5, 0x0f6d6ff3, 0x83f44239, + 0x2e0b4482, 0xa4842004, 0x69c8f04a, 0x9e1f9b5e, 0x21c66842, 0xf6e96c9a, + 0x670c9c61, 0xabd388f0, 0x6a51a0d2, 0xd8542f68, 0x960fa728, 0xab5133a3, + 0x6eef0b6c, 0x137a3be4, 0xba3bf050, 0x7efb2a98, 0xa1f1651d, 0x39af0176, + 0x66ca593e, 0x82430e88, 0x8cee8619, 0x456f9fb4, 0x7d84a5c3, 0x3b8b5ebe, + 0xe06f75d8, 0x85c12073, 0x401a449f, 0x56c16aa6, 0x4ed3aa62, 0x363f7706, + 0x1bfedf72, 0x429b023d, 0x37d0d724, 0xd00a1248, 0xdb0fead3, 0x49f1c09b, + 0x075372c9, 0x80991b7b, 0x25d479d8, 0xf6e8def7, 0xe3fe501a, 0xb6794c3b, + 0x976ce0bd, 0x04c006ba, 0xc1a94fb6, 0x409f60c4, 0x5e5c9ec2, 0x196a2463, + 0x68fb6faf, 0x3e6c53b5, 0x1339b2eb, 0x3b52ec6f, 0x6dfc511f, 0x9b30952c, + 0xcc814544, 0xaf5ebd09, 0xbee3d004, 0xde334afd, 0x660f2807, 0x192e4bb3, + 0xc0cba857, 0x45c8740f, 0xd20b5f39, 0xb9d3fbdb, 0x5579c0bd, 0x1a60320a, + 0xd6a100c6, 0x402c7279, 0x679f25fe, 0xfb1fa3cc, 0x8ea5e9f8, 0xdb3222f8, + 0x3c7516df, 0xfd616b15, 0x2f501ec8, 0xad0552ab, 0x323db5fa, 0xfd238760, + 0x53317b48, 0x3e00df82, 0x9e5c57bb, 0xca6f8ca0, 0x1a87562e, 0xdf1769db, + 0xd542a8f6, 0x287effc3, 0xac6732c6, 0x8c4f5573, 0x695b27b0, 0xbbca58c8, + 0xe1ffa35d, 0xb8f011a0, 0x10fa3d98, 0xfd2183b8, 0x4afcb56c, 0x2dd1d35b, + 0x9a53e479, 0xb6f84565, 0xd28e49bc, 0x4bfb9790, 0xe1ddf2da, 0xa4cb7e33, + 0x62fb1341, 0xcee4c6e8, 0xef20cada, 0x36774c01, 0xd07e9efe, 0x2bf11fb4, + 0x95dbda4d, 0xae909198, 0xeaad8e71, 0x6b93d5a0, 0xd08ed1d0, 0xafc725e0, + 0x8e3c5b2f, 0x8e7594b7, 0x8ff6e2fb, 0xf2122b64, 0x8888b812, 0x900df01c, + 0x4fad5ea0, 0x688fc31c, 0xd1cff191, 0xb3a8c1ad, 0x2f2f2218, 0xbe0e1777, + 0xea752dfe, 0x8b021fa1, 0xe5a0cc0f, 0xb56f74e8, 0x18acf3d6, 0xce89e299, + 0xb4a84fe0, 0xfd13e0b7, 0x7cc43b81, 0xd2ada8d9, 0x165fa266, 0x80957705, + 0x93cc7314, 0x211a1477, 0xe6ad2065, 0x77b5fa86, 0xc75442f5, 0xfb9d35cf, + 0xebcdaf0c, 0x7b3e89a0, 0xd6411bd3, 0xae1e7e49, 0x00250e2d, 0x2071b35e, + 0x226800bb, 0x57b8e0af, 0x2464369b, 0xf009b91e, 0x5563911d, 0x59dfa6aa, + 0x78c14389, 0xd95a537f, 0x207d5ba2, 0x02e5b9c5, 0x83260376, 0x6295cfa9, + 0x11c81968, 0x4e734a41, 0xb3472dca, 0x7b14a94a, 0x1b510052, 0x9a532915, + 0xd60f573f, 0xbc9bc6e4, 0x2b60a476, 0x81e67400, 0x08ba6fb5, 0x571be91f, + 0xf296ec6b, 0x2a0dd915, 0xb6636521, 0xe7b9f9b6, 0xff34052e, 0xc5855664, + 0x53b02d5d, 0xa99f8fa1, 0x08ba4799, 0x6e85076a]) + +iSbox1 :: Sbox +iSbox1 = array (0,255) (zip [0..255] + [0x4b7a70e9, 0xb5b32944, 0xdb75092e, 0xc4192623, 0xad6ea6b0, 0x49a7df7d, + 0x9cee60b8, 0x8fedb266, 0xecaa8c71, 0x699a17ff, 0x5664526c, 0xc2b19ee1, + 0x193602a5, 0x75094c29, 0xa0591340, 0xe4183a3e, 0x3f54989a, 0x5b429d65, + 0x6b8fe4d6, 0x99f73fd6, 0xa1d29c07, 0xefe830f5, 0x4d2d38e6, 0xf0255dc1, + 0x4cdd2086, 0x8470eb26, 0x6382e9c6, 0x021ecc5e, 0x09686b3f, 0x3ebaefc9, + 0x3c971814, 0x6b6a70a1, 0x687f3584, 0x52a0e286, 0xb79c5305, 0xaa500737, + 0x3e07841c, 0x7fdeae5c, 0x8e7d44ec, 0x5716f2b8, 0xb03ada37, 0xf0500c0d, + 0xf01c1f04, 0x0200b3ff, 0xae0cf51a, 0x3cb574b2, 0x25837a58, 0xdc0921bd, + 0xd19113f9, 0x7ca92ff6, 0x94324773, 0x22f54701, 0x3ae5e581, 0x37c2dadc, + 0xc8b57634, 0x9af3dda7, 0xa9446146, 0x0fd0030e, 0xecc8c73e, 0xa4751e41, + 0xe238cd99, 0x3bea0e2f, 0x3280bba1, 0x183eb331, 0x4e548b38, 0x4f6db908, + 0x6f420d03, 0xf60a04bf, 0x2cb81290, 0x24977c79, 0x5679b072, 0xbcaf89af, + 0xde9a771f, 0xd9930810, 0xb38bae12, 0xdccf3f2e, 0x5512721f, 0x2e6b7124, + 0x501adde6, 0x9f84cd87, 0x7a584718, 0x7408da17, 0xbc9f9abc, 0xe94b7d8c, + 0xec7aec3a, 0xdb851dfa, 0x63094366, 0xc464c3d2, 0xef1c1847, 0x3215d908, + 0xdd433b37, 0x24c2ba16, 0x12a14d43, 0x2a65c451, 0x50940002, 0x133ae4dd, + 0x71dff89e, 0x10314e55, 0x81ac77d6, 0x5f11199b, 0x043556f1, 0xd7a3c76b, + 0x3c11183b, 0x5924a509, 0xf28fe6ed, 0x97f1fbfa, 0x9ebabf2c, 0x1e153c6e, + 0x86e34570, 0xeae96fb1, 0x860e5e0a, 0x5a3e2ab3, 0x771fe71c, 0x4e3d06fa, + 0x2965dcb9, 0x99e71d0f, 0x803e89d6, 0x5266c825, 0x2e4cc978, 0x9c10b36a, + 0xc6150eba, 0x94e2ea78, 0xa5fc3c53, 0x1e0a2df4, 0xf2f74ea7, 0x361d2b3d, + 0x1939260f, 0x19c27960, 0x5223a708, 0xf71312b6, 0xebadfe6e, 0xeac31f66, + 0xe3bc4595, 0xa67bc883, 0xb17f37d1, 0x018cff28, 0xc332ddef, 0xbe6c5aa5, + 0x65582185, 0x68ab9802, 0xeecea50f, 0xdb2f953b, 0x2aef7dad, 0x5b6e2f84, + 0x1521b628, 0x29076170, 0xecdd4775, 0x619f1510, 0x13cca830, 0xeb61bd96, + 0x0334fe1e, 0xaa0363cf, 0xb5735c90, 0x4c70a239, 0xd59e9e0b, 0xcbaade14, + 0xeecc86bc, 0x60622ca7, 0x9cab5cab, 0xb2f3846e, 0x648b1eaf, 0x19bdf0ca, + 0xa02369b9, 0x655abb50, 0x40685a32, 0x3c2ab4b3, 0x319ee9d5, 0xc021b8f7, + 0x9b540b19, 0x875fa099, 0x95f7997e, 0x623d7da8, 0xf837889a, 0x97e32d77, + 0x11ed935f, 0x16681281, 0x0e358829, 0xc7e61fd6, 0x96dedfa1, 0x7858ba99, + 0x57f584a5, 0x1b227263, 0x9b83c3ff, 0x1ac24696, 0xcdb30aeb, 0x532e3054, + 0x8fd948e4, 0x6dbc3128, 0x58ebf2ef, 0x34c6ffea, 0xfe28ed61, 0xee7c3c73, + 0x5d4a14d9, 0xe864b7e3, 0x42105d14, 0x203e13e0, 0x45eee2b6, 0xa3aaabea, + 0xdb6c4f15, 0xfacb4fd0, 0xc742f442, 0xef6abbb5, 0x654f3b1d, 0x41cd2105, + 0xd81e799e, 0x86854dc7, 0xe44b476a, 0x3d816250, 0xcf62a1f2, 0x5b8d2646, + 0xfc8883a0, 0xc1c7b6a3, 0x7f1524c3, 0x69cb7492, 0x47848a0b, 0x5692b285, + 0x095bbf00, 0xad19489d, 0x1462b174, 0x23820e00, 0x58428d2a, 0x0c55f5ea, + 0x1dadf43e, 0x233f7061, 0x3372f092, 0x8d937e41, 0xd65fecf1, 0x6c223bdb, + 0x7cde3759, 0xcbee7460, 0x4085f2a7, 0xce77326e, 0xa6078084, 0x19f8509e, + 0xe8efd855, 0x61d99735, 0xa969a7aa, 0xc50c06c2, 0x5a04abfc, 0x800bcadc, + 0x9e447a2e, 0xc3453484, 0xfdd56705, 0x0e1e9ec9, 0xdb73dbd3, 0x105588cd, + 0x675fda79, 0xe3674340, 0xc5c43465, 0x713e38d8, 0x3d28f89e, 0xf16dff20, + 0x153e21e7, 0x8fb03d4a, 0xe6e39f2b, 0xdb83adf7]) + +iSbox2 :: Sbox +iSbox2 = array (0,255) (zip [0..255] + [0xe93d5a68, 0x948140f7, 0xf64c261c, 0x94692934, 0x411520f7, 0x7602d4f7, + 0xbcf46b2e, 0xd4a20068, 0xd4082471, 0x3320f46a, 0x43b7d4b7, 0x500061af, + 0x1e39f62e, 0x97244546, 0x14214f74, 0xbf8b8840, 0x4d95fc1d, 0x96b591af, + 0x70f4ddd3, 0x66a02f45, 0xbfbc09ec, 0x03bd9785, 0x7fac6dd0, 0x31cb8504, + 0x96eb27b3, 0x55fd3941, 0xda2547e6, 0xabca0a9a, 0x28507825, 0x530429f4, + 0x0a2c86da, 0xe9b66dfb, 0x68dc1462, 0xd7486900, 0x680ec0a4, 0x27a18dee, + 0x4f3ffea2, 0xe887ad8c, 0xb58ce006, 0x7af4d6b6, 0xaace1e7c, 0xd3375fec, + 0xce78a399, 0x406b2a42, 0x20fe9e35, 0xd9f385b9, 0xee39d7ab, 0x3b124e8b, + 0x1dc9faf7, 0x4b6d1856, 0x26a36631, 0xeae397b2, 0x3a6efa74, 0xdd5b4332, + 0x6841e7f7, 0xca7820fb, 0xfb0af54e, 0xd8feb397, 0x454056ac, 0xba489527, + 0x55533a3a, 0x20838d87, 0xfe6ba9b7, 0xd096954b, 0x55a867bc, 0xa1159a58, + 0xcca92963, 0x99e1db33, 0xa62a4a56, 0x3f3125f9, 0x5ef47e1c, 0x9029317c, + 0xfdf8e802, 0x04272f70, 0x80bb155c, 0x05282ce3, 0x95c11548, 0xe4c66d22, + 0x48c1133f, 0xc70f86dc, 0x07f9c9ee, 0x41041f0f, 0x404779a4, 0x5d886e17, + 0x325f51eb, 0xd59bc0d1, 0xf2bcc18f, 0x41113564, 0x257b7834, 0x602a9c60, + 0xdff8e8a3, 0x1f636c1b, 0x0e12b4c2, 0x02e1329e, 0xaf664fd1, 0xcad18115, + 0x6b2395e0, 0x333e92e1, 0x3b240b62, 0xeebeb922, 0x85b2a20e, 0xe6ba0d99, + 0xde720c8c, 0x2da2f728, 0xd0127845, 0x95b794fd, 0x647d0862, 0xe7ccf5f0, + 0x5449a36f, 0x877d48fa, 0xc39dfd27, 0xf33e8d1e, 0x0a476341, 0x992eff74, + 0x3a6f6eab, 0xf4f8fd37, 0xa812dc60, 0xa1ebddf8, 0x991be14c, 0xdb6e6b0d, + 0xc67b5510, 0x6d672c37, 0x2765d43b, 0xdcd0e804, 0xf1290dc7, 0xcc00ffa3, + 0xb5390f92, 0x690fed0b, 0x667b9ffb, 0xcedb7d9c, 0xa091cf0b, 0xd9155ea3, + 0xbb132f88, 0x515bad24, 0x7b9479bf, 0x763bd6eb, 0x37392eb3, 0xcc115979, + 0x8026e297, 0xf42e312d, 0x6842ada7, 0xc66a2b3b, 0x12754ccc, 0x782ef11c, + 0x6a124237, 0xb79251e7, 0x06a1bbe6, 0x4bfb6350, 0x1a6b1018, 0x11caedfa, + 0x3d25bdd8, 0xe2e1c3c9, 0x44421659, 0x0a121386, 0xd90cec6e, 0xd5abea2a, + 0x64af674e, 0xda86a85f, 0xbebfe988, 0x64e4c3fe, 0x9dbc8057, 0xf0f7c086, + 0x60787bf8, 0x6003604d, 0xd1fd8346, 0xf6381fb0, 0x7745ae04, 0xd736fccc, + 0x83426b33, 0xf01eab71, 0xb0804187, 0x3c005e5f, 0x77a057be, 0xbde8ae24, + 0x55464299, 0xbf582e61, 0x4e58f48f, 0xf2ddfda2, 0xf474ef38, 0x8789bdc2, + 0x5366f9c3, 0xc8b38e74, 0xb475f255, 0x46fcd9b9, 0x7aeb2661, 0x8b1ddf84, + 0x846a0e79, 0x915f95e2, 0x466e598e, 0x20b45770, 0x8cd55591, 0xc902de4c, + 0xb90bace1, 0xbb8205d0, 0x11a86248, 0x7574a99e, 0xb77f19b6, 0xe0a9dc09, + 0x662d09a1, 0xc4324633, 0xe85a1f02, 0x09f0be8c, 0x4a99a025, 0x1d6efe10, + 0x1ab93d1d, 0x0ba5a4df, 0xa186f20f, 0x2868f169, 0xdcb7da83, 0x573906fe, + 0xa1e2ce9b, 0x4fcd7f52, 0x50115e01, 0xa70683fa, 0xa002b5c4, 0x0de6d027, + 0x9af88c27, 0x773f8641, 0xc3604c06, 0x61a806b5, 0xf0177a28, 0xc0f586e0, + 0x006058aa, 0x30dc7d62, 0x11e69ed7, 0x2338ea63, 0x53c2dd94, 0xc2c21634, + 0xbbcbee56, 0x90bcb6de, 0xebfc7da1, 0xce591d76, 0x6f05e409, 0x4b7c0188, + 0x39720a3d, 0x7c927c24, 0x86e3725f, 0x724d9db9, 0x1ac15bb4, 0xd39eb8fc, + 0xed545578, 0x08fca5b5, 0xd83d7cd3, 0x4dad0fc4, 0x1e50ef5e, 0xb161e6f8, + 0xa28514d9, 0x6c51133c, 0x6fd5c7e7, 0x56e14ec4, 0x362abfce, 0xddc6c837, + 0xd79a3234, 0x92638212, 0x670efa8e, 0x406000e0]) + +iSbox3 :: Sbox +iSbox3 = array (0,255) (zip [0..255] + [0x3a39ce37, 0xd3faf5cf, 0xabc27737, 0x5ac52d1b, 0x5cb0679e, 0x4fa33742, + 0xd3822740, 0x99bc9bbe, 0xd5118e9d, 0xbf0f7315, 0xd62d1c7e, 0xc700c47b, + 0xb78c1b6b, 0x21a19045, 0xb26eb1be, 0x6a366eb4, 0x5748ab2f, 0xbc946e79, + 0xc6a376d2, 0x6549c2c8, 0x530ff8ee, 0x468dde7d, 0xd5730a1d, 0x4cd04dc6, + 0x2939bbdb, 0xa9ba4650, 0xac9526e8, 0xbe5ee304, 0xa1fad5f0, 0x6a2d519a, + 0x63ef8ce2, 0x9a86ee22, 0xc089c2b8, 0x43242ef6, 0xa51e03aa, 0x9cf2d0a4, + 0x83c061ba, 0x9be96a4d, 0x8fe51550, 0xba645bd6, 0x2826a2f9, 0xa73a3ae1, + 0x4ba99586, 0xef5562e9, 0xc72fefd3, 0xf752f7da, 0x3f046f69, 0x77fa0a59, + 0x80e4a915, 0x87b08601, 0x9b09e6ad, 0x3b3ee593, 0xe990fd5a, 0x9e34d797, + 0x2cf0b7d9, 0x022b8b51, 0x96d5ac3a, 0x017da67d, 0xd1cf3ed6, 0x7c7d2d28, + 0x1f9f25cf, 0xadf2b89b, 0x5ad6b472, 0x5a88f54c, 0xe029ac71, 0xe019a5e6, + 0x47b0acfd, 0xed93fa9b, 0xe8d3c48d, 0x283b57cc, 0xf8d56629, 0x79132e28, + 0x785f0191, 0xed756055, 0xf7960e44, 0xe3d35e8c, 0x15056dd4, 0x88f46dba, + 0x03a16125, 0x0564f0bd, 0xc3eb9e15, 0x3c9057a2, 0x97271aec, 0xa93a072a, + 0x1b3f6d9b, 0x1e6321f5, 0xf59c66fb, 0x26dcf319, 0x7533d928, 0xb155fdf5, + 0x03563482, 0x8aba3cbb, 0x28517711, 0xc20ad9f8, 0xabcc5167, 0xccad925f, + 0x4de81751, 0x3830dc8e, 0x379d5862, 0x9320f991, 0xea7a90c2, 0xfb3e7bce, + 0x5121ce64, 0x774fbe32, 0xa8b6e37e, 0xc3293d46, 0x48de5369, 0x6413e680, + 0xa2ae0810, 0xdd6db224, 0x69852dfd, 0x09072166, 0xb39a460a, 0x6445c0dd, + 0x586cdecf, 0x1c20c8ae, 0x5bbef7dd, 0x1b588d40, 0xccd2017f, 0x6bb4e3bb, + 0xdda26a7e, 0x3a59ff45, 0x3e350a44, 0xbcb4cdd5, 0x72eacea8, 0xfa6484bb, + 0x8d6612ae, 0xbf3c6f47, 0xd29be463, 0x542f5d9e, 0xaec2771b, 0xf64e6370, + 0x740e0d8d, 0xe75b1357, 0xf8721671, 0xaf537d5d, 0x4040cb08, 0x4eb4e2cc, + 0x34d2466a, 0x0115af84, 0xe1b00428, 0x95983a1d, 0x06b89fb4, 0xce6ea048, + 0x6f3f3b82, 0x3520ab82, 0x011a1d4b, 0x277227f8, 0x611560b1, 0xe7933fdc, + 0xbb3a792b, 0x344525bd, 0xa08839e1, 0x51ce794b, 0x2f32c9b7, 0xa01fbac9, + 0xe01cc87e, 0xbcc7d1f6, 0xcf0111c3, 0xa1e8aac7, 0x1a908749, 0xd44fbd9a, + 0xd0dadecb, 0xd50ada38, 0x0339c32a, 0xc6913667, 0x8df9317c, 0xe0b12b4f, + 0xf79e59b7, 0x43f5bb3a, 0xf2d519ff, 0x27d9459c, 0xbf97222c, 0x15e6fc2a, + 0x0f91fc71, 0x9b941525, 0xfae59361, 0xceb69ceb, 0xc2a86459, 0x12baa8d1, + 0xb6c1075e, 0xe3056a0c, 0x10d25065, 0xcb03a442, 0xe0ec6e0e, 0x1698db3b, + 0x4c98a0be, 0x3278e964, 0x9f1f9532, 0xe0d392df, 0xd3a0342b, 0x8971f21e, + 0x1b0a7441, 0x4ba3348c, 0xc5be7120, 0xc37632d8, 0xdf359f8d, 0x9b992f2e, + 0xe60b6f47, 0x0fe3f11d, 0xe54cda54, 0x1edad891, 0xce6279cf, 0xcd3e7e6f, + 0x1618b166, 0xfd2c1d05, 0x848fd2c5, 0xf6fb2299, 0xf523f357, 0xa6327623, + 0x93a83531, 0x56cccd02, 0xacf08162, 0x5a75ebb5, 0x6e163697, 0x88d273cc, + 0xde966292, 0x81b949d0, 0x4c50901b, 0x71c65614, 0xe6c6c7bd, 0x327a140a, + 0x45e1d006, 0xc3f27b9a, 0xc9aa53fd, 0x62a80f00, 0xbb25bfe2, 0x35bdd2f6, + 0x71126905, 0xb2040222, 0xb6cbcf7c, 0xcd769c2b, 0x53113ec0, 0x1640e3d3, + 0x38abbd60, 0x2547adf0, 0xba38209c, 0xf746ce76, 0x77afa1c5, 0x20756060, + 0x85cbfe4e, 0x8ae88dd8, 0x7aaaf9b0, 0x4cf9aa7e, 0x1948c25c, 0x02fb8a8c, + 0x01c36ae4, 0xd6ebe1f9, 0x90d4f869, 0xa65cdea0, 0x3f09252d, 0xc208e69f, + 0xb74e6132, 0xce77e25b, 0x578fdfe3, 0x3ac372e6]) ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -127,3 +127,4 @@ test('T21710a', [ unless(tables_next_to_code(), skip) , when(wordsize(32), skip) , only_ways(['optasm']) , grep_errmsg('(call)',[1]) ] , compile, ['-ddump-cmm -dno-typeable-binds']) +test('T23002', normal, compile, ['-fregs-graph']) ===================================== testsuite/tests/numeric/should_compile/T23019.hs ===================================== @@ -0,0 +1,21 @@ +module T23019 + ( + eexponent + ) where + +-- spine lazy, value strict list of doubles +data List + = Nil + | {-# UNPACK #-} !Double :! List + +infixr 5 :! + +newtype TowerDouble = Tower { getTower :: List } + +primal :: TowerDouble -> Double +primal (Tower (x:!_)) = x +primal _ = 0 + +eexponent :: TowerDouble -> Int +eexponent = exponent . primal + ===================================== testsuite/tests/numeric/should_compile/all.T ===================================== @@ -19,3 +19,4 @@ test('T20347', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-b test('T20448', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T19641', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T15547', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) +test('T23019', normal, compile, ['-O']) ===================================== testsuite/tests/patsyn/should_compile/T23038.hs ===================================== @@ -0,0 +1,19 @@ +{-# LANGUAGE PatternSynonyms, ViewPatterns, ScopedTypeVariables #-} + +module T23038 where + +import GHC.Types( Any ) +import Unsafe.Coerce( unsafeCoerce ) + +pattern N1 :: forall a. () => forall. () => a -> Any +pattern N1 { fld1 } <- ( unsafeCoerce -> fld1 ) + where N1 = unsafeCoerce + +pattern N2 :: forall. () => forall a. () => a -> Any +pattern N2 { fld2 } <- ( unsafeCoerce -> fld2 ) + where N2 = unsafeCoerce + +test1, test2 :: forall a. Any -> a + +test1 = fld1 -- Should be OK +test2 = fld2 -- Should be rejected ===================================== testsuite/tests/patsyn/should_compile/T23038.stderr ===================================== @@ -0,0 +1,6 @@ + +T23038.hs:19:9: error: [GHC-55876] + • Cannot use record selector ‘fld2’ as a function due to escaped type variables + • In the expression: fld2 + In an equation for ‘test2’: test2 = fld2 + Suggested fix: Use pattern-matching syntax instead ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -83,3 +83,4 @@ test('T17775-singleton', normal, compile, ['']) test('T14630', normal, compile, ['-Wname-shadowing']) test('T21531', [ grep_errmsg(r'INLINE') ], compile, ['-ddump-ds']) test('T22521', normal, compile, ['']) +test('T23038', normal, compile_fail, ['']) ===================================== testsuite/tests/perf/should_run/T18964.hs ===================================== @@ -3,6 +3,9 @@ import Data.Int main :: IO () main = do + -- This test aims to track #18964, the fix of which had to be reverted in the + -- wake of #23021. The comments below apply to a world where #18964 is fixed. + -------------------- -- drop should fuse away and the program should consume O(1) space -- If fusion fails, this allocates about 640MB. print $ sum $ drop 10 [0..10000000::Int64] ===================================== testsuite/tests/perf/should_run/T23021.hs ===================================== @@ -0,0 +1,30 @@ +-- The direct implementation of drop and dropWhile operates in O(1) space. +-- This regression test asserts that potential fusion rules for dropWhile/drop +-- maintain that property for the fused pipelines in dropWhile2 and drop2 (which +-- are marked NOINLINE for that purpose). +-- #23021 was opened because we had fusion rules in place that did not maintain +-- this property. + +dropWhile2 :: Int -> [Int] -> [Int] +dropWhile2 n = dropWhile (< n) . dropWhile (< n) +{-# NOINLINE dropWhile2 #-} + +drop2 :: Int -> [Int] -> [Int] +drop2 n = drop n . drop n +{-# NOINLINE drop2 #-} + +main :: IO () +main = do + let xs = [0..9999999] + print $ last $ dropWhile2 0 xs + print $ last $ dropWhile2 1 xs + print $ last $ dropWhile2 2 xs + print $ last $ dropWhile2 3 xs + print $ last $ dropWhile2 4 xs + print $ last $ dropWhile2 5 xs + print $ last $ drop2 0 xs + print $ last $ drop2 1 xs + print $ last $ drop2 2 xs + print $ last $ drop2 3 xs + print $ last $ drop2 4 xs + print $ last $ drop2 5 xs ===================================== testsuite/tests/perf/should_run/T23021.stdout ===================================== @@ -0,0 +1,12 @@ +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -411,4 +411,7 @@ test('T21839r', compile_and_run, ['-O']) +# #18964 should be marked expect_broken, but it's still useful to track that +# perf doesn't regress further, so it is not marked as such. test('T18964', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O']) +test('T23021', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O2']) ===================================== 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_fail/T22707.hs ===================================== @@ -0,0 +1,22 @@ +module T22707 where + +newtype Cont o i a = Cont {runCont ::(a -> i) -> o } + +t1:: Cont (i2 -> o) i1 a -> Cont o i2 (a -> i1) +t1 c = Cont $ \ati1tti2 -> (runCont c) (ati1tti2 $ \a -> evalCont (t1 c) >>== \ati1 -> return ati1 a ) + +evalCont:: Cont o a a -> o +evalCont c = (runCont c)id + +instance Monad (Cont p p) where + return a = Cont ($ a) + (>>=) = (>>==) + +class PMonad m where + (>>==):: m p q a -> (a -> m q r b) -> m p r b + +instance PMonad Cont where + (Cont cont) >>== afmb = Cont $ \bti -> cont $ \a -> (runCont . afmb) a bti + +main:: IO () +main = putStrLn "bug" ===================================== testsuite/tests/typecheck/should_fail/T22707.stderr ===================================== @@ -0,0 +1,16 @@ + +T22707.hs:6:37: error: [GHC-18872] + • Couldn't match kind ‘*’ with ‘GHC.Types.RuntimeRep’ + When matching types + p0 :: * + GHC.Types.LiftedRep :: GHC.Types.RuntimeRep + Expected: Cont o i1 a + Actual: Cont (i2 -> o) i1 a + • In the first argument of ‘runCont’, namely ‘c’ + In the expression: + (runCont c) + (ati1tti2 $ \ a -> evalCont (t1 c) >>== \ ati1 -> return ati1 a) + In the second argument of ‘($)’, namely + ‘\ ati1tti2 + -> (runCont c) + (ati1tti2 $ \ a -> evalCont (t1 c) >>== \ ati1 -> ...)’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -321,6 +321,7 @@ test('T7856', normal, compile_fail, ['']) test('T7869', normal, compile_fail, ['']) test('T7892', normal, compile_fail, ['']) test('T7809', normal, compile_fail, ['']) +test('T22707', normal, compile_fail, ['']) test('T7989', normal, compile_fail, ['']) test('T8034', normal, compile_fail, ['']) test('T8142', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae30c8a98791d7254bf3c15b979add63ec56e585...a44834b17ba3d01133ffa7b1bf6de6bf92fdd3c7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae30c8a98791d7254bf3c15b979add63ec56e585...a44834b17ba3d01133ffa7b1bf6de6bf92fdd3c7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 16:47:06 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 02 Mar 2023 11:47:06 -0500 Subject: [Git][ghc/ghc][wip/T23026] Get the right in-scope set in etaBodyForJoinPoint Message-ID: <6400d30a917da_3ab52b157055c10695d@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23026 at Glasgow Haskell Compiler / GHC Commits: ab16d39c by Simon Peyton Jones at 2023-03-02T17:45:54+01:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 3 changed files: - compiler/GHC/Core/Opt/Arity.hs - + testsuite/tests/simplCore/should_compile/T23026.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3105,7 +3105,7 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs -- Adds as many binders as asked for; assumes expr is not a lambda etaBodyForJoinPoint :: Int -> CoreExpr -> ([CoreBndr], CoreExpr) etaBodyForJoinPoint need_args body - = go need_args (exprType body) (init_subst body) [] body + = go need_args body_ty (mkEmptySubst in_scope) [] body where go 0 _ _ rev_bs e = (reverse rev_bs, e) @@ -3124,9 +3124,16 @@ etaBodyForJoinPoint need_args body = pprPanic "etaBodyForJoinPoint" $ int need_args $$ ppr body $$ ppr (exprType body) - init_subst e = mkEmptySubst (mkInScopeSet (exprFreeVars e)) - - + body_ty = exprType body + in_scope = mkInScopeSet (exprFreeVars body `unionVarSet` tyCoVarsOfType body_ty) + -- in_scope is a bit tricky. + -- - We are wrapping `body` in some value lambdas, so must not shadow + -- any free vars of `body` + -- - We are wrapping `body` in some type lambdas, so must not shadow any + -- tyvars in body_ty. Example: body is just a variable + -- (g :: forall (a::k). T k a -> Int) + -- We must not shadown that `k` when adding the /\a. So treat the free vars + -- of body_ty as in-scope. Showed up in #23026. -------------- freshEtaId :: Int -> Subst -> Scaled Type -> (Subst, Id) ===================================== testsuite/tests/simplCore/should_compile/T23026.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} + +module T23026 where + +import Data.Kind (Type) + +data Sing (a :: k) +data SingInstance (a :: k) = SingInstance (Sing a) + +app :: (Sing a -> SingInstance a) -> Sing a -> SingInstance a +app f x = f x +{-# NOINLINE app #-} + +withSomeSing + :: forall k2 k1 (f :: k2 -> k1 -> Type) a2 a1. + (Sing a2, Sing a1) + -> f a2 a1 + -> (forall b2 b1. f b2 b1 -> Int) + -> Int +withSomeSing (sa2, sa1) x g = + case app SingInstance sa2 of + SingInstance _ -> + case app SingInstance sa1 of + SingInstance _ -> g x +{-# INLINABLE withSomeSing #-} ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -476,3 +476,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) +test('T23026', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab16d39cc9bcd5b34071e18c82d0473891fa0ed3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab16d39cc9bcd5b34071e18c82d0473891fa0ed3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 16:56:42 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 02 Mar 2023 11:56:42 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-9.6 Message-ID: <6400d54ae636c_3ab52b1abdfa010799d@gitlab.mail> Ben Gamari pushed new branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 17:31:30 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 02 Mar 2023 12:31:30 -0500 Subject: [Git][ghc/ghc][wip/backports-9.6] 5 commits: rts: Introduce stgMallocAlignedBytes Message-ID: <6400dd72a40c7_3ab52b280fdac120385@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC Commits: 72087b1d by Ben Gamari at 2023-03-02T12:31:12-05:00 rts: Introduce stgMallocAlignedBytes (cherry picked from commit eeb5bd560942a4968980fb341d9ebca33ad3302b) - - - - - ac7bbf64 by Ben Gamari at 2023-03-02T12:31:12-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. (cherry picked from commit 2cca72cd3e4de25fa81dc6fcc9979e613697a838) - - - - - 4bda8c6c by Ben Gamari at 2023-03-02T12:31:12-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. (cherry picked from commit 05c5b14c5e28c279de0d84472526eccb7f05d00a) - - - - - cbdc5d51 by Ben Gamari at 2023-03-02T12:31:12-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. (cherry picked from commit 8bed166bb79445f90015757fd5baac69a7b835df) - - - - - fbc98e66 by Ben Gamari at 2023-03-02T12:31:12-05:00 docs/relnotes: Mention -fprefer-byte-code Closes #23027. - - - - - 7 changed files: - compiler/GHC/CmmToAsm.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/using-optimisation.rst - rts/Capability.c - rts/Capability.h - rts/RtsUtils.c - rts/RtsUtils.h Changes: ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -812,6 +812,19 @@ generateJumpTables ncgImpl xs = concatMap f xs -- ----------------------------------------------------------------------------- -- Shortcut branches +-- Note [No asm-shortcutting on Darwin] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Asm-shortcutting may produce relative references to symbols defined in +-- other compilation units. This is not something that MachO relocations +-- support (see #21972). For this reason we disable the optimisation on Darwin. +-- We do so in the backend without a warning since this flag is enabled by +-- `-O2`. +-- +-- Another way to address this issue would be to rather implement a +-- PLT-relocatable jump-table strategy. However, this would only benefit Darwin +-- and does not seem worth the effort as this optimisation generally doesn't +-- offer terribly great benefits. + shortcutBranches :: forall statics instr jumpDest. (Outputable jumpDest) => NCGConfig @@ -822,6 +835,8 @@ shortcutBranches shortcutBranches config ncgImpl tops weights | ncgEnableShortcutting config + -- See Note [No asm-shortcutting on Darwin] + , not $ osMachOTarget $ platformOS $ ncgPlatform config = ( map (apply_mapping ncgImpl mapping) tops' , shortcutWeightMap mappingBid <$!> weights ) | otherwise ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -150,6 +150,12 @@ Compiler on the GHC wiki for the current status, project roadmap, build instructions and demos. +- GHC now offers a new flag, :ghc-flag:`-fprefer-byte-code`, which instructs + the compiler to to use byte-code when available when loading home package + modules for execution (e.g. when evaluating TH splices). This avoids the + considerable code generation and linking costs of native code, which is often + unnecessary for one-off Template Haskell splices. + - The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included in :extension:`PolyKinds` and :extension:`DataKinds`. ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -262,8 +262,10 @@ by saying ``-fno-wombat``. of a unconditionally jump, we replace all jumps to A by jumps to the successor of A. - This is mostly done during Cmm passes. However this can miss corner cases. So at -O2 - we run the pass again at the asm stage to catch these. + This is mostly done during Cmm passes. However this can miss corner cases. + So at ``-O2`` this flag runs the pass again at the assembly stage to catch + these. Note that due to platform limitations (:ghc-ticket:`21972`) this flag + does nothing on macOS. .. ghc-flag:: -fblock-layout-cfg :shortdesc: Use the new cfg based block layout algorithm. ===================================== rts/Capability.c ===================================== @@ -438,8 +438,9 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS) { for (uint32_t i = 0; i < to; i++) { if (i >= from) { - capabilities[i] = stgMallocBytes(sizeof(Capability), - "moreCapabilities"); + capabilities[i] = stgMallocAlignedBytes(sizeof(Capability), + CAPABILITY_ALIGNMENT, + "moreCapabilities"); initCapability(capabilities[i], i); } } @@ -1274,7 +1275,7 @@ freeCapabilities (void) Capability *cap = getCapability(i); freeCapability(cap); if (cap != &MainCapability) { - stgFree(cap); + stgFreeAligned(cap); } } #else ===================================== rts/Capability.h ===================================== @@ -32,10 +32,8 @@ // anything else, so round it up to a cache line size: #if defined(s390x_HOST_ARCH) #define CAPABILITY_ALIGNMENT 256 -#elif !defined(mingw32_HOST_OS) -#define CAPABILITY_ALIGNMENT 64 #else -#define CAPABILITY_ALIGNMENT 1 +#define CAPABILITY_ALIGNMENT 64 #endif /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */ ===================================== rts/RtsUtils.c ===================================== @@ -57,9 +57,9 @@ extern char *ctime_r(const time_t *, char *); void * stgMallocBytes (size_t n, char *msg) { - void *space; + void *space = malloc(n); - if ((space = malloc(n)) == NULL) { + if (space == NULL) { /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): * * "Upon successful completion with size not equal to 0, malloc() shall @@ -128,6 +128,53 @@ stgFree(void* p) free(p); } +// N.B. Allocations resulting from this function must be freed by +// `stgFreeAligned`, not `stgFree`. This is necessary due to the properties of Windows' `_aligned_malloc` +void * +stgMallocAlignedBytes (size_t n, size_t align, char *msg) +{ + void *space; + +#if defined(mingw32_HOST_OS) + space = _aligned_malloc(n, align); +#else + if (posix_memalign(&space, align, n)) { + space = NULL; // Allocation failed + } +#endif + + if (space == NULL) { + /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): + * + * "Upon successful completion with size not equal to 0, malloc() shall + * return a pointer to the allocated space. If size is 0, either a null + * pointer or a unique pointer that can be successfully passed to free() + * shall be returned. Otherwise, it shall return a null pointer and set + * errno to indicate the error." + * + * Consequently, a NULL pointer being returned by `malloc()` for a 0-size + * allocation is *not* to be considered an error. + */ + if (n == 0) return NULL; + + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + rtsConfig.mallocFailHook((W_) n, msg); + stg_exit(EXIT_INTERNAL_ERROR); + } + IF_DEBUG(zero_on_gc, memset(space, 0xbb, n)); + return space; +} + +void +stgFreeAligned (void *p) +{ +#if defined(mingw32_HOST_OS) + _aligned_free(p); +#else + free(p); +#endif +} + /* ----------------------------------------------------------------------------- Stack/heap overflow -------------------------------------------------------------------------- */ ===================================== rts/RtsUtils.h ===================================== @@ -48,6 +48,10 @@ void *stgCallocBytes(size_t count, size_t size, char *msg) char *stgStrndup(const char *s, size_t n) STG_MALLOC STG_MALLOC1(stgFree); +void *stgMallocAlignedBytes(size_t n, size_t align, char *msg); + +void stgFreeAligned(void *p); + /* ----------------------------------------------------------------------------- * Misc other utilities * -------------------------------------------------------------------------- */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7b95eb56719904042c02a3ef84184cea84a3890...fbc98e66077b933b634bf86a8d4a739ef10ea232 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7b95eb56719904042c02a3ef84184cea84a3890...fbc98e66077b933b634bf86a8d4a739ef10ea232 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 17:47:32 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 02 Mar 2023 12:47:32 -0500 Subject: [Git][ghc/ghc][wip/T23026] 7 commits: Take more care with unlifted bindings in the specialiser Message-ID: <6400e1348dba7_3ab52b2bf06241321bb@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23026 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 70a34368 by Simon Peyton Jones at 2023-03-02T17:48:41+00:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 27 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Tc/TyCl/Utils.hs - hadrian/bindist/Makefile - libraries/base/GHC/List.hs - + testsuite/tests/patsyn/should_compile/T23038.hs - + testsuite/tests/patsyn/should_compile/T23038.stderr - testsuite/tests/patsyn/should_compile/all.T - testsuite/tests/perf/should_run/T18964.hs - + testsuite/tests/perf/should_run/T23021.hs - + testsuite/tests/perf/should_run/T23021.stdout - testsuite/tests/perf/should_run/all.T - + testsuite/tests/simplCore/should_compile/T23026.hs - testsuite/tests/simplCore/should_compile/all.T - + 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/Arity.hs ===================================== @@ -3105,7 +3105,7 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs -- Adds as many binders as asked for; assumes expr is not a lambda etaBodyForJoinPoint :: Int -> CoreExpr -> ([CoreBndr], CoreExpr) etaBodyForJoinPoint need_args body - = go need_args (exprType body) (init_subst body) [] body + = go need_args body_ty (mkEmptySubst in_scope) [] body where go 0 _ _ rev_bs e = (reverse rev_bs, e) @@ -3124,9 +3124,16 @@ etaBodyForJoinPoint need_args body = pprPanic "etaBodyForJoinPoint" $ int need_args $$ ppr body $$ ppr (exprType body) - init_subst e = mkEmptySubst (mkInScopeSet (exprFreeVars e)) - - + body_ty = exprType body + in_scope = mkInScopeSet (exprFreeVars body `unionVarSet` tyCoVarsOfType body_ty) + -- in_scope is a bit tricky. + -- - We are wrapping `body` in some value lambdas, so must not shadow + -- any free vars of `body` + -- - We are wrapping `body` in some type lambdas, so must not shadow any + -- tyvars in body_ty. Example: body is just a variable + -- (g :: forall (a::k). T k a -> Int) + -- We must not shadown that `k` when adding the /\a. So treat the free vars + -- of body_ty as in-scope. Showed up in #23026. -------------- freshEtaId :: Int -> Subst -> Scaled Type -> (Subst, Id) ===================================== 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# = + 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') } ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -903,19 +903,30 @@ mkOneRecordSelector all_cons idDetails fl has_sel con1 = assert (not (null cons_w_field)) $ head cons_w_field -- Selector type; Note [Polymorphic selectors] - field_ty = conLikeFieldType con1 lbl - data_tv_set = tyCoVarsOfTypes (data_ty : req_theta) - data_tvbs = filter (\tvb -> binderVar tvb `elemVarSet` data_tv_set) $ - conLikeUserTyVarBinders con1 + (univ_tvs, _, _, _, req_theta, _, data_ty) = conLikeFullSig con1 + + field_ty = conLikeFieldType con1 lbl + field_ty_tvs = tyCoVarsOfType field_ty + data_ty_tvs = tyCoVarsOfType data_ty + sel_tvs = field_ty_tvs `unionVarSet` data_ty_tvs + sel_tvbs = filter (\tvb -> binderVar tvb `elemVarSet` sel_tvs) $ + conLikeUserTyVarBinders con1 -- is_naughty: see Note [Naughty record selectors] - is_naughty = not (tyCoVarsOfType field_ty `subVarSet` data_tv_set) - || has_sel == NoFieldSelectors -- No field selectors => all are naughty - -- thus suppressing making a binding - -- A slight hack! + is_naughty = not ok_scoping || no_selectors + ok_scoping = case con1 of + RealDataCon {} -> field_ty_tvs `subVarSet` data_ty_tvs + PatSynCon {} -> field_ty_tvs `subVarSet` mkVarSet univ_tvs + -- In the PatSynCon case, the selector type is (data_ty -> field_ty), but + -- fvs(data_ty) are all universals (see Note [Pattern synonym result type] in + -- GHC.Core.PatSyn, so no need to check them. + + no_selectors = has_sel == NoFieldSelectors -- No field selectors => all are naughty + -- thus suppressing making a binding + -- A slight hack! sel_ty | is_naughty = unitTy -- See Note [Naughty record selectors] - | otherwise = mkForAllTys (tyVarSpecToBinders data_tvbs) $ + | otherwise = mkForAllTys (tyVarSpecToBinders sel_tvbs) $ -- Urgh! See Note [The stupid context] in GHC.Core.DataCon mkPhiTy (conLikeStupidTheta con1) $ -- req_theta is empty for normal DataCon @@ -926,7 +937,7 @@ mkOneRecordSelector all_cons idDetails fl has_sel -- fields in all the constructor have multiplicity Many. field_ty - -- Make the binding: sel (C2 { fld = x }) = x + -- make the binding: sel (C2 { fld = x }) = x -- sel (C7 { fld = x }) = x -- where cons_w_field = [C2,C7] sel_bind = mkTopFunBind Generated sel_lname alts @@ -976,8 +987,6 @@ mkOneRecordSelector all_cons idDetails fl has_sel where inst_tys = dataConResRepTyArgs dc - (_, _, _, _, req_theta, _, data_ty) = conLikeFullSig con1 - unit_rhs = mkLHsTupleExpr [] noExtField msg_lit = HsStringPrim NoSourceText (bytesFS (field_label lbl)) @@ -1036,36 +1045,42 @@ so that if the user tries to use 'x' as a selector we can bleat helpfully, rather than saying unhelpfully that 'x' is not in scope. Hence the sel_naughty flag, to identify record selectors that don't really exist. -In general, a field is "naughty" if its type mentions a type variable that -isn't in - * the (original, user-written) result type of the constructor, or - * the "required theta" for the constructor - -Note that this *allows* GADT record selectors (Note [GADT record -selectors]) whose types may look like sel :: T [a] -> a - -The "required theta" part is illustrated by test patsyn/should_run/records_run -where we have - - pattern ReadP :: Read a => a -> String - pattern ReadP {readp} <- (read -> readp) - -The selector is defined like this: - - $selreadp :: ReadP a => String -> a - $selReadP s = readp s - -Perfectly fine! The (ReadP a) constraint lets us contructor a value -of type 'a' from a bare String. NB: "required theta" is empty for -data cons (see conLikeFullSig), so this reasoning only bites for -patttern synonyms. - For naughty selectors we make a dummy binding sel = () so that the later type-check will add them to the environment, and they'll be exported. The function is never called, because the typechecker spots the sel_naughty field. +To determine naughtiness we distingish two cases: + +* For RealDataCons, a field is "naughty" if its type mentions a + type variable that isn't in the (original, user-written) result type + of the constructor. Note that this *allows* GADT record selectors + (Note [GADT record selectors]) whose types may look like sel :: T [a] -> a + +* For a PatSynCon, a field is "naughty" if its type mentions a type variable + that isn't in the universal type variables. + + This is a bit subtle. Consider test patsyn/should_run/records_run: + pattern ReadP :: forall a. ReadP a => a -> String + pattern ReadP {fld} <- (read -> readp) + The selector is defined like this: + $selReadPfld :: forall a. ReadP a => String -> a + $selReadPfld @a (d::ReadP a) s = readp @a d s + Perfectly fine! The (ReadP a) constraint lets us contruct a value of type + 'a' from a bare String. + + Another curious case (#23038): + pattern N :: forall a. () => forall. () => a -> Any + pattern N { fld } <- ( unsafeCoerce -> fld1 ) where N = unsafeCoerce + The selector looks like this + $selNfld :: forall a. Any -> a + $selNfld @a x = unsafeCoerce @Any @a x + Pretty strange (but used in the `cleff` package). + + TL;DR for pattern synonyms, the selector is OK if the field type mentions only + the universal type variables of the pattern synonym. + Note [NoFieldSelectors and naughty record selectors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Under NoFieldSelectors (see Note [NoFieldSelectors] in GHC.Rename.Env), record ===================================== 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)")' >> $@ ===================================== libraries/base/GHC/List.hs ===================================== @@ -886,23 +886,12 @@ takeWhileFB p c n = \x r -> if p x then x `c` r else n -- [] -- >>> dropWhile (< 0) [1,2,3] -- [1,2,3] -{-# NOINLINE [1] dropWhile #-} dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile _ [] = [] dropWhile p xs@(x:xs') | p x = dropWhile p xs' | otherwise = xs -{-# INLINE [0] dropWhileFB #-} -- See Note [Inline FB functions] -dropWhileFB :: (a -> Bool) -> (a -> b -> b) -> b -> a -> (Bool -> b) -> Bool -> b -dropWhileFB p c _n x xs = \drp -> if drp && p x then xs True else x `c` xs False - -{-# RULES -"dropWhile" [~1] forall p xs. dropWhile p xs = - build (\c n -> foldr (dropWhileFB p c n) (flipSeq n) xs True) -"dropWhileList" [1] forall p xs. foldr (dropWhileFB p (:) []) (flipSeq []) xs True = dropWhile p xs - #-} - -- | 'take' @n@, applied to a list @xs@, returns the prefix of @xs@ -- of length @n@, or @xs@ itself if @n >= 'length' xs at . -- @@ -998,31 +987,17 @@ drop n xs | n <= 0 = xs drop _ [] = [] drop n (_:xs) = drop (n-1) xs #else /* hack away */ -{-# INLINE[1] drop #-} -- Why [1]? See justification on take! => RULES +{-# INLINE drop #-} drop n ls | n <= 0 = ls | otherwise = unsafeDrop n ls - --- A version of drop that drops the whole list if given an argument --- less than 1 -{-# NOINLINE [0] unsafeDrop #-} -- See Note [Inline FB functions] -unsafeDrop :: Int -> [a] -> [a] -unsafeDrop !_ [] = [] -unsafeDrop 1 (_:xs) = xs -unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs - -{-# RULES -"drop" [~1] forall n xs . drop n xs = - build (\c nil -> if n <= 0 - then foldr c nil xs - else foldr (dropFB c nil) (flipSeq nil) xs n) -"unsafeDropList" [1] forall n xs . foldr (dropFB (:) []) (flipSeq []) xs n - = unsafeDrop n xs - #-} - -{-# INLINE [0] dropFB #-} -- See Note [Inline FB functions] -dropFB :: (a -> b -> b) -> b -> a -> (Int -> b) -> Int -> b -dropFB c _n x xs = \ m -> if m <= 0 then x `c` xs m else xs (m-1) + where + -- A version of drop that drops the whole list if given an argument + -- less than 1 + unsafeDrop :: Int -> [a] -> [a] + unsafeDrop !_ [] = [] + unsafeDrop 1 (_:xs) = xs + unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs #endif -- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of ===================================== testsuite/tests/patsyn/should_compile/T23038.hs ===================================== @@ -0,0 +1,19 @@ +{-# LANGUAGE PatternSynonyms, ViewPatterns, ScopedTypeVariables #-} + +module T23038 where + +import GHC.Types( Any ) +import Unsafe.Coerce( unsafeCoerce ) + +pattern N1 :: forall a. () => forall. () => a -> Any +pattern N1 { fld1 } <- ( unsafeCoerce -> fld1 ) + where N1 = unsafeCoerce + +pattern N2 :: forall. () => forall a. () => a -> Any +pattern N2 { fld2 } <- ( unsafeCoerce -> fld2 ) + where N2 = unsafeCoerce + +test1, test2 :: forall a. Any -> a + +test1 = fld1 -- Should be OK +test2 = fld2 -- Should be rejected ===================================== testsuite/tests/patsyn/should_compile/T23038.stderr ===================================== @@ -0,0 +1,6 @@ + +T23038.hs:19:9: error: [GHC-55876] + • Cannot use record selector ‘fld2’ as a function due to escaped type variables + • In the expression: fld2 + In an equation for ‘test2’: test2 = fld2 + Suggested fix: Use pattern-matching syntax instead ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -83,3 +83,4 @@ test('T17775-singleton', normal, compile, ['']) test('T14630', normal, compile, ['-Wname-shadowing']) test('T21531', [ grep_errmsg(r'INLINE') ], compile, ['-ddump-ds']) test('T22521', normal, compile, ['']) +test('T23038', normal, compile_fail, ['']) ===================================== testsuite/tests/perf/should_run/T18964.hs ===================================== @@ -3,6 +3,9 @@ import Data.Int main :: IO () main = do + -- This test aims to track #18964, the fix of which had to be reverted in the + -- wake of #23021. The comments below apply to a world where #18964 is fixed. + -------------------- -- drop should fuse away and the program should consume O(1) space -- If fusion fails, this allocates about 640MB. print $ sum $ drop 10 [0..10000000::Int64] ===================================== testsuite/tests/perf/should_run/T23021.hs ===================================== @@ -0,0 +1,30 @@ +-- The direct implementation of drop and dropWhile operates in O(1) space. +-- This regression test asserts that potential fusion rules for dropWhile/drop +-- maintain that property for the fused pipelines in dropWhile2 and drop2 (which +-- are marked NOINLINE for that purpose). +-- #23021 was opened because we had fusion rules in place that did not maintain +-- this property. + +dropWhile2 :: Int -> [Int] -> [Int] +dropWhile2 n = dropWhile (< n) . dropWhile (< n) +{-# NOINLINE dropWhile2 #-} + +drop2 :: Int -> [Int] -> [Int] +drop2 n = drop n . drop n +{-# NOINLINE drop2 #-} + +main :: IO () +main = do + let xs = [0..9999999] + print $ last $ dropWhile2 0 xs + print $ last $ dropWhile2 1 xs + print $ last $ dropWhile2 2 xs + print $ last $ dropWhile2 3 xs + print $ last $ dropWhile2 4 xs + print $ last $ dropWhile2 5 xs + print $ last $ drop2 0 xs + print $ last $ drop2 1 xs + print $ last $ drop2 2 xs + print $ last $ drop2 3 xs + print $ last $ drop2 4 xs + print $ last $ drop2 5 xs ===================================== testsuite/tests/perf/should_run/T23021.stdout ===================================== @@ -0,0 +1,12 @@ +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 +9999999 ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -411,4 +411,7 @@ test('T21839r', compile_and_run, ['-O']) +# #18964 should be marked expect_broken, but it's still useful to track that +# perf doesn't regress further, so it is not marked as such. test('T18964', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O']) +test('T23021', [collect_stats('bytes allocated', 1), only_ways(['normal'])], compile_and_run, ['-O2']) ===================================== testsuite/tests/simplCore/should_compile/T23026.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} + +module T23026 where + +import Data.Kind (Type) + +data Sing (a :: k) +data SingInstance (a :: k) = SingInstance (Sing a) + +app :: (Sing a -> SingInstance a) -> Sing a -> SingInstance a +app f x = f x +{-# NOINLINE app #-} + +withSomeSing + :: forall k2 k1 (f :: k2 -> k1 -> Type) a2 a1. + (Sing a2, Sing a1) + -> f a2 a1 + -> (forall b2 b1. f b2 b1 -> Int) + -> Int +withSomeSing (sa2, sa1) x g = + case app SingInstance sa2 of + SingInstance _ -> + case app SingInstance sa1 of + SingInstance _ -> g x +{-# INLINABLE withSomeSing #-} ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -476,3 +476,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) +test('T23026', normal, compile, ['-O']) ===================================== 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/ab16d39cc9bcd5b34071e18c82d0473891fa0ed3...70a3436804ad6a385c3199ac63b4bf5168ba1c15 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab16d39cc9bcd5b34071e18c82d0473891fa0ed3...70a3436804ad6a385c3199ac63b4bf5168ba1c15 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 17:57:12 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 02 Mar 2023 12:57:12 -0500 Subject: [Git][ghc/ghc][wip/T22023] More fixes for `type data` declarations Message-ID: <6400e378de891_3ab52b32d77a81356ca@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22023 at Glasgow Haskell Compiler / GHC Commits: 18d49249 by Simon Peyton Jones at 2023-03-02T17:58:12+00:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 10 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Gen/App.hs - + testsuite/tests/gadt/T23022.hs - + testsuite/tests/gadt/T23023.hs - testsuite/tests/gadt/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1669,13 +1669,25 @@ dataConOtherTheta dc = dcOtherTheta dc -- evidence, after any flattening has been done and without substituting for -- any type variables dataConRepArgTys :: DataCon -> [Scaled Type] -dataConRepArgTys (MkData { dcRep = rep - , dcEqSpec = eq_spec +dataConRepArgTys (MkData { dcRep = rep + , dcEqSpec = eq_spec , dcOtherTheta = theta - , dcOrigArgTys = orig_arg_tys }) + , dcOrigArgTys = orig_arg_tys + , dcRepTyCon = tc }) = case rep of - NoDataConRep -> assert (null eq_spec) $ map unrestricted theta ++ orig_arg_tys DCR { dcr_arg_tys = arg_tys } -> arg_tys + NoDataConRep + | isTypeDataTyCon tc -> assert (null theta) $ + orig_arg_tys + -- `type data` declarations can be GADTs (and hence have an eq_spec) + -- but no wrapper. They cannot have a theta. + -- See Note [Type data declarations] in GHC.Rename.Module + -- You might wonder why we ever call dataConRepArgTys for `type data`; + -- I think it's because of the call in mkDataCon, which in turn feeds + -- into dcRepArity, which in turn is used in mkDataConWorkId. + -- c.f. #23022 + | otherwise -> assert (null eq_spec) $ + map unrestricted theta ++ orig_arg_tys -- | The string @package:module.name@ identifying a constructor, which is attached -- to its info table and used by the GHCi debugger and the heap profiler ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1021,6 +1021,9 @@ lintIdOcc var nargs ; checkDeadIdOcc var ; checkJoinOcc var nargs + ; case isDataConId_maybe var of + Nothing -> return () + Just dc -> checkTypeDataConOcc "expression" dc ; usage <- varCallSiteUsage var @@ -1107,6 +1110,13 @@ checkJoinOcc var n_args | otherwise = return () +checkTypeDataConOcc :: String -> DataCon -> LintM () +-- Check that the Id is not a data constructor of a `type data` declaration +-- Invariant (I1) of Note [Type data declarations] in GHC.Rename.Module +checkTypeDataConOcc what dc + = checkL (not (isTypeDataTyCon (dataConTyCon dc))) $ + (text "type data constructor found in a" <+> text what <> colon <+> ppr dc) + -- | This function checks that we are able to perform eta expansion for -- functions with no binding, in order to satisfy invariant I3 -- from Note [Representation polymorphism invariants] in GHC.Core. @@ -1561,10 +1571,11 @@ lintCoreAlt case_bndr scrut_ty _scrut_mult alt_ty alt@(Alt (DataAlt con) args rh = zeroUE <$ addErrL (mkNewTyDataConAltMsg scrut_ty alt) | Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty = addLoc (CaseAlt alt) $ do - { -- First instantiate the universally quantified - -- type variables of the data constructor - -- We've already check - lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + { checkTypeDataConOcc "pattern" con + ; lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + + -- Instantiate the universally quantified + -- type variables of the data constructor ; let { con_payload_ty = piResultTys (dataConRepType con) tycon_arg_tys ; binderMult (Named _) = ManyTy ; binderMult (Anon st _) = scaledMult st ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, tyConDataCons - , tyConFamilySize ) + , tyConFamilySize, isTypeDataTyCon ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey ) @@ -3188,6 +3188,8 @@ caseRules _ (App (App (Var f) (Type ty)) v) -- dataToTag x | Just DataToTagOp <- isPrimOpId_maybe f , Just (tc, _) <- tcSplitTyConApp_maybe ty , isAlgTyCon tc + , not (isTypeDataTyCon tc) -- See wrinkle (W2c) in GHC.Rename.Module + -- Note [Type data declarations] = Just (v, tx_con_dtt ty , \v -> App (App (Var f) (Type ty)) (Var v)) ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -845,7 +845,8 @@ There are two exceptions where we avoid refining a DEFAULT case: __DEFAULT -> () Namely, we do _not_ want to match on `A`, as it doesn't exist at the value - level! + level! See wrinkle (W2b) in GHC.Rename.Module Note [Type data declarations] + Note [Combine identical alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -152,8 +152,8 @@ vanillaCompleteMatchTC tc = tc == tYPETyCon = Just [] | -- Similarly, treat `type data` declarations as empty data types on -- the term level, as `type data` data constructors only exist at - -- the type level (#22964). - -- See Note [Type data declarations] in GHC.Rename.Module. + -- the type level (#22964). See wrinkle (W2a) in + -- Note [Type data declarations] in GHC.Rename.Module. isTypeDataTyCon tc = Just [] | otherwise = tyConDataCons_maybe tc in vanillaCompleteMatch . mkUniqDSet . map RealDataCon <$> mb_dcs ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2073,9 +2073,31 @@ preceded by `type`, with the following restrictions: (R5) There are no deriving clauses. +The data constructors of a `type data` declaration obey the following +Core invariant: + +(I1) The data constructors of a `type data` declaration may be mentioned in + /types/, but never in /terms/ or the /pattern of a case alternative/. + The main parts of the implementation are: -* (R0): The parser recognizes `type data` (but not `type newtype`). +* Wrappers. A `type data` declaration _never_ generates wrappers for + its data constructors, as they only make sense for value-level data + constructors. See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` + for the place where this check is implemented. + + This includes `type data` declarations implemented as GADTs, such as + this example from #22948: + + type data T a where + A :: T Int + B :: T a + + If `T` were an ordinary `data` declaration, then `A` would have a wrapper + to account for the GADT-like equality in its return type. Because `T` is + declared as a `type data` declaration, however, the wrapper is omitted. + +* The parser recognizes `type data` (but not `type newtype`); this ensures (R0). * During the initial construction of the AST, GHC.Parser.PostProcess.checkNewOrData sets the `Bool` argument of the @@ -2134,54 +2156,48 @@ The main parts of the implementation are: `type data` declarations. When these are converted back to Hs types in a splice, the constructors are placed in the TcCls namespace. -* A `type data` declaration _never_ generates wrappers for its data - constructors, as they only make sense for value-level data constructors. - See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where - this check is implemented. +Extra wrinkles: - This includes `type data` declarations implemented as GADTs, such as - this example from #22948: +(W1) To prevent users from conjuring up `type data` values at the term level, + we disallow using the tagToEnum# function on a type headed by a `type + data` type. For instance, GHC will reject this code: - type data T a where - A :: T Int - B :: T a + type data Letter = A | B | C - If `T` were an ordinary `data` declaration, then `A` would have a wrapper - to account for the GADT-like equality in its return type. Because `T` is - declared as a `type data` declaration, however, the wrapper is omitted. - -* Although `type data` data constructors do not exist at the value level, - it is still possible to match on a value whose type is headed by a `type data` - type constructor, such as this example from #22964: - - type data T a where - A :: T Int - B :: T a + f :: Letter + f = tagToEnum# 0# - f :: T a -> () - f x = case x of {} + See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. - This has two consequences: +(W2) Although `type data` data constructors do not exist at the value level, + it is still possible to match on a value whose type is headed by a `type data` + type constructor, such as this example from #22964: - * During checking the coverage of `f`'s pattern matches, we treat `T` as if it - were an empty data type so that GHC does not warn the user to match against - `A` or `B`. (Otherwise, you end up with the bug reported in #22964.) - See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. + type data T a where + A :: T Int + B :: T a - * In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case with - the data constructor. See - Note [Refine DEFAULT case alternatives] Exception 2, in GHC.Core.Utils. + f :: T a -> () + f x = case x of {} -* To prevent users from conjuring up `type data` values at the term level, we - disallow using the tagToEnum# function on a type headed by a `type data` - type. For instance, GHC will reject this code: + And yet we must guarantee invariant (I1). This has three consequences: - type data Letter = A | B | C + (W2a) During checking the coverage of `f`'s pattern matches, we treat `T` + as if it were an empty data type so that GHC does not warn the user + to match against `A` or `B`. (Otherwise, you end up with the bug + reported in #22964.) See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. - f :: Letter - f = tagToEnum# 0# + (W2b) In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case + with the data constructor, else (I1) is violated. See GHC.Core.Utils + Note [Refine DEFAULT case alternatives] Exception 2 - See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. + (W2c) In `GHC.Core.Opt.ConstantFold.caseRules`, disable the rule for + `dataToTag#` in the case of `type data`. We do not want to transform + case dataToTag# x of t -> blah + into + case x of { A -> ...; B -> .. } + because again that conjures up the type-level-only data contructors + `A` and `B` in a pattern, violating (I1) (#23023). -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -1222,7 +1222,8 @@ tcTagToEnum tc_fun fun_ctxt tc_args res_ty vanilla_result = rebuildHsApps tc_fun fun_ctxt tc_args res_ty check_enumeration ty' tc - | -- isTypeDataTyCon: see Note [Type data declarations] in GHC.Rename.Module + | -- isTypeDataTyCon: see wrinkle (W1) in + -- Note [Type data declarations] in GHC.Rename.Module isTypeDataTyCon tc = addErrTc (TcRnTagToEnumResTyTypeData ty') | isEnumerationTyCon tc = return () | otherwise = addErrTc (TcRnTagToEnumResTyNotAnEnum ty') ===================================== testsuite/tests/gadt/T23022.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module B where + +type data T a b where + MkT :: T a a + +f :: T a b -> T a b +f x = x ===================================== testsuite/tests/gadt/T23023.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeData, MagicHash #-} +module B where + +import GHC.Exts + +type data T a b where + MkT :: T a a + +f :: T Int Bool -> Char +f x = case dataToTag# x of + 0# -> 'a' + _ -> 'b' ===================================== testsuite/tests/gadt/all.T ===================================== @@ -129,3 +129,5 @@ test('T22235', normal, compile, ['']) test('T19847', normal, compile, ['']) test('T19847a', normal, compile, ['-ddump-types']) test('T19847b', normal, compile, ['']) +test('T23022', normal, compile, ['-dcore-lint']) +test('T23023', normal, compile, ['-dcore-lint']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18d492497f781722ef40c413d86cdf16448569f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18d492497f781722ef40c413d86cdf16448569f2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 17:59:05 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 02 Mar 2023 12:59:05 -0500 Subject: [Git][ghc/ghc][wip/T22023] More fixes for `type data` declarations Message-ID: <6400e3e952caf_3ab52b32d78201361e4@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22023 at Glasgow Haskell Compiler / GHC Commits: 7fefa808 by Simon Peyton Jones at 2023-03-02T18:00:20+00:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 10 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Gen/App.hs - + testsuite/tests/gadt/T23022.hs - + testsuite/tests/gadt/T23023.hs - testsuite/tests/gadt/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1669,13 +1669,25 @@ dataConOtherTheta dc = dcOtherTheta dc -- evidence, after any flattening has been done and without substituting for -- any type variables dataConRepArgTys :: DataCon -> [Scaled Type] -dataConRepArgTys (MkData { dcRep = rep - , dcEqSpec = eq_spec +dataConRepArgTys (MkData { dcRep = rep + , dcEqSpec = eq_spec , dcOtherTheta = theta - , dcOrigArgTys = orig_arg_tys }) + , dcOrigArgTys = orig_arg_tys + , dcRepTyCon = tc }) = case rep of - NoDataConRep -> assert (null eq_spec) $ map unrestricted theta ++ orig_arg_tys DCR { dcr_arg_tys = arg_tys } -> arg_tys + NoDataConRep + | isTypeDataTyCon tc -> assert (null theta) $ + orig_arg_tys + -- `type data` declarations can be GADTs (and hence have an eq_spec) + -- but no wrapper. They cannot have a theta. + -- See Note [Type data declarations] in GHC.Rename.Module + -- You might wonder why we ever call dataConRepArgTys for `type data`; + -- I think it's because of the call in mkDataCon, which in turn feeds + -- into dcRepArity, which in turn is used in mkDataConWorkId. + -- c.f. #23022 + | otherwise -> assert (null eq_spec) $ + map unrestricted theta ++ orig_arg_tys -- | The string @package:module.name@ identifying a constructor, which is attached -- to its info table and used by the GHCi debugger and the heap profiler ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1021,6 +1021,9 @@ lintIdOcc var nargs ; checkDeadIdOcc var ; checkJoinOcc var nargs + ; case isDataConId_maybe var of + Nothing -> return () + Just dc -> checkTypeDataConOcc "expression" dc ; usage <- varCallSiteUsage var @@ -1107,6 +1110,13 @@ checkJoinOcc var n_args | otherwise = return () +checkTypeDataConOcc :: String -> DataCon -> LintM () +-- Check that the Id is not a data constructor of a `type data` declaration +-- Invariant (I1) of Note [Type data declarations] in GHC.Rename.Module +checkTypeDataConOcc what dc + = checkL (not (isTypeDataTyCon (dataConTyCon dc))) $ + (text "type data constructor found in a" <+> text what <> colon <+> ppr dc) + -- | This function checks that we are able to perform eta expansion for -- functions with no binding, in order to satisfy invariant I3 -- from Note [Representation polymorphism invariants] in GHC.Core. @@ -1561,10 +1571,11 @@ lintCoreAlt case_bndr scrut_ty _scrut_mult alt_ty alt@(Alt (DataAlt con) args rh = zeroUE <$ addErrL (mkNewTyDataConAltMsg scrut_ty alt) | Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty = addLoc (CaseAlt alt) $ do - { -- First instantiate the universally quantified - -- type variables of the data constructor - -- We've already check - lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + { checkTypeDataConOcc "pattern" con + ; lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + + -- Instantiate the universally quantified + -- type variables of the data constructor ; let { con_payload_ty = piResultTys (dataConRepType con) tycon_arg_tys ; binderMult (Named _) = ManyTy ; binderMult (Anon st _) = scaledMult st ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, tyConDataCons - , tyConFamilySize ) + , tyConFamilySize, isTypeDataTyCon ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey ) @@ -3188,6 +3188,8 @@ caseRules _ (App (App (Var f) (Type ty)) v) -- dataToTag x | Just DataToTagOp <- isPrimOpId_maybe f , Just (tc, _) <- tcSplitTyConApp_maybe ty , isAlgTyCon tc + , not (isTypeDataTyCon tc) -- See wrinkle (W2c) in GHC.Rename.Module + -- Note [Type data declarations] = Just (v, tx_con_dtt ty , \v -> App (App (Var f) (Type ty)) (Var v)) ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -845,7 +845,8 @@ There are two exceptions where we avoid refining a DEFAULT case: __DEFAULT -> () Namely, we do _not_ want to match on `A`, as it doesn't exist at the value - level! + level! See wrinkle (W2b) in Note [Type data declarations] in GHC.Rename.Module + Note [Combine identical alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -152,8 +152,8 @@ vanillaCompleteMatchTC tc = tc == tYPETyCon = Just [] | -- Similarly, treat `type data` declarations as empty data types on -- the term level, as `type data` data constructors only exist at - -- the type level (#22964). - -- See Note [Type data declarations] in GHC.Rename.Module. + -- the type level (#22964). See wrinkle (W2a) in + -- Note [Type data declarations] in GHC.Rename.Module. isTypeDataTyCon tc = Just [] | otherwise = tyConDataCons_maybe tc in vanillaCompleteMatch . mkUniqDSet . map RealDataCon <$> mb_dcs ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2073,9 +2073,31 @@ preceded by `type`, with the following restrictions: (R5) There are no deriving clauses. +The data constructors of a `type data` declaration obey the following +Core invariant: + +(I1) The data constructors of a `type data` declaration may be mentioned in + /types/, but never in /terms/ or the /pattern of a case alternative/. + The main parts of the implementation are: -* (R0): The parser recognizes `type data` (but not `type newtype`). +* Wrappers. A `type data` declaration _never_ generates wrappers for + its data constructors, as they only make sense for value-level data + constructors. See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` + for the place where this check is implemented. + + This includes `type data` declarations implemented as GADTs, such as + this example from #22948: + + type data T a where + A :: T Int + B :: T a + + If `T` were an ordinary `data` declaration, then `A` would have a wrapper + to account for the GADT-like equality in its return type. Because `T` is + declared as a `type data` declaration, however, the wrapper is omitted. + +* The parser recognizes `type data` (but not `type newtype`); this ensures (R0). * During the initial construction of the AST, GHC.Parser.PostProcess.checkNewOrData sets the `Bool` argument of the @@ -2134,54 +2156,48 @@ The main parts of the implementation are: `type data` declarations. When these are converted back to Hs types in a splice, the constructors are placed in the TcCls namespace. -* A `type data` declaration _never_ generates wrappers for its data - constructors, as they only make sense for value-level data constructors. - See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where - this check is implemented. +Extra wrinkles: - This includes `type data` declarations implemented as GADTs, such as - this example from #22948: +(W1) To prevent users from conjuring up `type data` values at the term level, + we disallow using the tagToEnum# function on a type headed by a `type + data` type. For instance, GHC will reject this code: - type data T a where - A :: T Int - B :: T a + type data Letter = A | B | C - If `T` were an ordinary `data` declaration, then `A` would have a wrapper - to account for the GADT-like equality in its return type. Because `T` is - declared as a `type data` declaration, however, the wrapper is omitted. - -* Although `type data` data constructors do not exist at the value level, - it is still possible to match on a value whose type is headed by a `type data` - type constructor, such as this example from #22964: - - type data T a where - A :: T Int - B :: T a + f :: Letter + f = tagToEnum# 0# - f :: T a -> () - f x = case x of {} + See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. - This has two consequences: +(W2) Although `type data` data constructors do not exist at the value level, + it is still possible to match on a value whose type is headed by a `type data` + type constructor, such as this example from #22964: - * During checking the coverage of `f`'s pattern matches, we treat `T` as if it - were an empty data type so that GHC does not warn the user to match against - `A` or `B`. (Otherwise, you end up with the bug reported in #22964.) - See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. + type data T a where + A :: T Int + B :: T a - * In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case with - the data constructor. See - Note [Refine DEFAULT case alternatives] Exception 2, in GHC.Core.Utils. + f :: T a -> () + f x = case x of {} -* To prevent users from conjuring up `type data` values at the term level, we - disallow using the tagToEnum# function on a type headed by a `type data` - type. For instance, GHC will reject this code: + And yet we must guarantee invariant (I1). This has three consequences: - type data Letter = A | B | C + (W2a) During checking the coverage of `f`'s pattern matches, we treat `T` + as if it were an empty data type so that GHC does not warn the user + to match against `A` or `B`. (Otherwise, you end up with the bug + reported in #22964.) See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. - f :: Letter - f = tagToEnum# 0# + (W2b) In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case + with the data constructor, else (I1) is violated. See GHC.Core.Utils + Note [Refine DEFAULT case alternatives] Exception 2 - See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. + (W2c) In `GHC.Core.Opt.ConstantFold.caseRules`, disable the rule for + `dataToTag#` in the case of `type data`. We do not want to transform + case dataToTag# x of t -> blah + into + case x of { A -> ...; B -> .. } + because again that conjures up the type-level-only data contructors + `A` and `B` in a pattern, violating (I1) (#23023). -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -1222,7 +1222,8 @@ tcTagToEnum tc_fun fun_ctxt tc_args res_ty vanilla_result = rebuildHsApps tc_fun fun_ctxt tc_args res_ty check_enumeration ty' tc - | -- isTypeDataTyCon: see Note [Type data declarations] in GHC.Rename.Module + | -- isTypeDataTyCon: see wrinkle (W1) in + -- Note [Type data declarations] in GHC.Rename.Module isTypeDataTyCon tc = addErrTc (TcRnTagToEnumResTyTypeData ty') | isEnumerationTyCon tc = return () | otherwise = addErrTc (TcRnTagToEnumResTyNotAnEnum ty') ===================================== testsuite/tests/gadt/T23022.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module B where + +type data T a b where + MkT :: T a a + +f :: T a b -> T a b +f x = x ===================================== testsuite/tests/gadt/T23023.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeData, MagicHash #-} +module B where + +import GHC.Exts + +type data T a b where + MkT :: T a a + +f :: T Int Bool -> Char +f x = case dataToTag# x of + 0# -> 'a' + _ -> 'b' ===================================== testsuite/tests/gadt/all.T ===================================== @@ -129,3 +129,5 @@ test('T22235', normal, compile, ['']) test('T19847', normal, compile, ['']) test('T19847a', normal, compile, ['-ddump-types']) test('T19847b', normal, compile, ['']) +test('T23022', normal, compile, ['-dcore-lint']) +test('T23023', normal, compile, ['-dcore-lint']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7fefa808006f6fdb4744bde81f6ddb2fc27d6178 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7fefa808006f6fdb4744bde81f6ddb2fc27d6178 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 18:11:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Mar 2023 13:11:18 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Don't suppress *all* Wanteds Message-ID: <6400e6c6782ce_3ab52b376a310143287@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a54a4db7 by Richard Eisenberg at 2023-03-02T13:10:59-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 3352c8a8 by Luite Stegeman at 2023-03-02T13:11:03-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - 90f0d5b6 by Ben Gamari at 2023-03-02T13:11:04-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5102a031 by Ben Gamari at 2023-03-02T13:11:04-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 965beadf by Ben Gamari at 2023-03-02T13:11:04-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - ff692a5c by Ben Gamari at 2023-03-02T13:11:04-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - 5fb522ca by Matthew Pickering at 2023-03-02T13:11:05-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 3148604e by Zubin Duggal at 2023-03-02T13:11:05-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 18 changed files: - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Types/Constraint.hs - rts/Capability.c - rts/Capability.h - rts/RtsUtils.c - rts/RtsUtils.h - + testsuite/tests/codeGen/should_compile/T23002.hs - testsuite/tests/codeGen/should_compile/all.T - + testsuite/tests/ffi/should_compile/T22774.hs - testsuite/tests/ffi/should_compile/all.T - + testsuite/tests/numeric/should_compile/T23019.hs - testsuite/tests/numeric/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T22707.hs - + testsuite/tests/typecheck/should_fail/T22707.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -73,6 +73,7 @@ regUsageOfInstr :: Platform -> Instr -> RegUsage regUsageOfInstr platform instr = case instr of ANN _ i -> regUsageOfInstr platform i COMMENT{} -> usage ([], []) + MULTILINE_COMMENT{} -> usage ([], []) PUSH_STACK_FRAME -> usage ([], []) POP_STACK_FRAME -> usage ([], []) DELTA{} -> usage ([], []) @@ -207,11 +208,12 @@ callerSavedRegisters patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr patchRegsOfInstr instr env = case instr of -- 0. Meta Instructions - ANN d i -> ANN d (patchRegsOfInstr i env) - COMMENT{} -> instr - PUSH_STACK_FRAME -> instr - POP_STACK_FRAME -> instr - DELTA{} -> instr + ANN d i -> ANN d (patchRegsOfInstr i env) + COMMENT{} -> instr + MULTILINE_COMMENT{} -> instr + PUSH_STACK_FRAME -> instr + POP_STACK_FRAME -> instr + DELTA{} -> instr -- 1. Arithmetic Instructions ---------------------------------------------- ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -1110,14 +1110,10 @@ doubleOp2 _ _ _ _ = Nothing -------------------------- doubleDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr doubleDecodeOp env (LitDouble ((decodeFloat . fromRational @Double) -> (m, e))) - = Just $ mkCoreUnboxedTuple [ Lit (mkLitINT64 (toInteger m)) + = Just $ mkCoreUnboxedTuple [ Lit (mkLitInt64Wrap (toInteger m)) , mkIntVal platform (toInteger e) ] where platform = roPlatform env - mkLitINT64 | platformWordSizeInBits platform < 64 - = mkLitInt64Wrap - | otherwise - = mkLitIntWrap platform doubleDecodeOp _ _ = Nothing ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -476,30 +476,37 @@ mkErrorItem ct , ei_m_reason = m_reason , ei_suppress = suppress }} +-- | Actually report this 'ErrorItem'. +unsuppressErrorItem :: ErrorItem -> ErrorItem +unsuppressErrorItem ei = ei { ei_suppress = False } + ---------------------------------------------------------------- reportWanteds :: SolverReportErrCtxt -> TcLevel -> WantedConstraints -> TcM () reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics , wc_errors = errs }) | isEmptyWC wc = traceTc "reportWanteds empty WC" empty | otherwise - = do { tidy_items <- mapMaybeM mkErrorItem tidy_cts + = do { tidy_items1 <- mapMaybeM mkErrorItem tidy_cts ; traceTc "reportWanteds 1" (vcat [ text "Simples =" <+> ppr simples , text "Suppress =" <+> ppr (cec_suppress ctxt) , text "tidy_cts =" <+> ppr tidy_cts - , text "tidy_items =" <+> ppr tidy_items + , text "tidy_items1 =" <+> ppr tidy_items1 , text "tidy_errs =" <+> ppr tidy_errs ]) - -- This check makes sure that we aren't suppressing the only error that will - -- actually stop compilation - ; assertPprM - ( do { errs_already <- ifErrsM (return True) (return False) - ; return $ - errs_already || -- we already reported an error (perhaps from an outer implication) - null simples || -- no errors to report here - any ignoreConstraint simples || -- one error is ignorable (is reported elsewhere) - not (all ei_suppress tidy_items) -- not all errors are suppressed - } ) - (vcat [text "reportWanteds is suppressing all errors"]) + -- Catch an awkward case in which /all/ errors are suppressed: + -- see Wrinkle at end of Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint + -- Unless we are sure that an error will be reported some other way (details + -- in the defn of tidy_items) un-suppress the lot. This makes sure we don't forget to + -- report an error at all, which is catastrophic: GHC proceeds to desguar and optimise + -- the program, even though it is full of type errors (#22702, #22793) + ; errs_already <- ifErrsM (return True) (return False) + ; let tidy_items + | not errs_already -- Have not already reported an error (perhaps + -- from an outer implication); see #21405 + , not (any ignoreConstraint simples) -- No error is ignorable (is reported elsewhere) + , all ei_suppress tidy_items1 -- All errors are suppressed + = map unsuppressErrorItem tidy_items1 + | otherwise = tidy_items1 -- First, deal with any out-of-scope errors: ; let (out_of_scope, other_holes, not_conc_errs) = partition_errors tidy_errs ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -341,9 +341,10 @@ tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) (L ls safety) mh checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty return (CImport src (L lc cconv) (L ls safety) mh (CFunction target)) | cconv == JavaScriptCallConv = do + cconv' <- checkCConv (Right idecl) cconv checkCg (Right idecl) backendValidityOfCImport -- leave the rest to the JS backend (at least for now) - return (CImport src (L lc cconv) (L ls safety) mh (CFunction target)) + return (CImport src (L lc cconv') (L ls safety) mh (CFunction target)) | otherwise = do -- Normal foreign import checkCg (Right idecl) backendValidityOfCImport cconv' <- checkCConv (Right idecl) cconv ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -2127,10 +2127,10 @@ uses GHC.Tc.Utils.anyUnfilledCoercionHoles to look through any filled coercion holes. The idea is that we wish to report the "root cause" -- the error that rewrote all the others. -Worry: It seems possible that *all* unsolved wanteds are rewritten by other -unsolved wanteds, so that e.g. w1 has w2 in its rewriter set, and w2 has -w1 in its rewiter set. We are unable to come up with an example of this in -practice, however, and so we believe this case cannot happen. +Wrinkle: In #22707, we have a case where all of the Wanteds have rewritten +each other. In order to report /some/ error in this case, we simply report +all the Wanteds. The user will get a perhaps-confusing error message, but +they've written a confusing program! Note [Avoiding rewriting cycles] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== rts/Capability.c ===================================== @@ -438,8 +438,9 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS) { for (uint32_t i = 0; i < to; i++) { if (i >= from) { - capabilities[i] = stgMallocBytes(sizeof(Capability), - "moreCapabilities"); + capabilities[i] = stgMallocAlignedBytes(sizeof(Capability), + CAPABILITY_ALIGNMENT, + "moreCapabilities"); initCapability(capabilities[i], i); } } @@ -1274,7 +1275,7 @@ freeCapabilities (void) Capability *cap = getCapability(i); freeCapability(cap); if (cap != &MainCapability) { - stgFree(cap); + stgFreeAligned(cap); } } #else ===================================== rts/Capability.h ===================================== @@ -28,6 +28,14 @@ #include "BeginPrivate.h" +// We never want a Capability to overlap a cache line with +// anything else, so round it up to a cache line size: +#if defined(s390x_HOST_ARCH) +#define CAPABILITY_ALIGNMENT 256 +#else +#define CAPABILITY_ALIGNMENT 64 +#endif + /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */ struct Capability_ { // State required by the STG virtual machine when running Haskell @@ -169,14 +177,12 @@ struct Capability_ { StgTRecHeader *free_trec_headers; uint32_t transaction_tokens; } // typedef Capability is defined in RtsAPI.h - // We never want a Capability to overlap a cache line with anything - // else, so round it up to a cache line size: -#if defined(s390x_HOST_ARCH) - ATTRIBUTE_ALIGNED(256) -#elif !defined(mingw32_HOST_OS) - ATTRIBUTE_ALIGNED(64) -#endif - ; + ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT) +; + +// We allocate arrays of Capabilities therefore we must ensure that the size is +// a multiple of the claimed alignment +GHC_STATIC_ASSERT(sizeof(struct Capability_) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size"); #if defined(THREADED_RTS) #define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId()) ===================================== rts/RtsUtils.c ===================================== @@ -57,9 +57,9 @@ extern char *ctime_r(const time_t *, char *); void * stgMallocBytes (size_t n, char *msg) { - void *space; + void *space = malloc(n); - if ((space = malloc(n)) == NULL) { + if (space == NULL) { /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): * * "Upon successful completion with size not equal to 0, malloc() shall @@ -128,6 +128,53 @@ stgFree(void* p) free(p); } +// N.B. Allocations resulting from this function must be freed by +// `stgFreeAligned`, not `stgFree`. This is necessary due to the properties of Windows' `_aligned_malloc` +void * +stgMallocAlignedBytes (size_t n, size_t align, char *msg) +{ + void *space; + +#if defined(mingw32_HOST_OS) + space = _aligned_malloc(n, align); +#else + if (posix_memalign(&space, align, n)) { + space = NULL; // Allocation failed + } +#endif + + if (space == NULL) { + /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): + * + * "Upon successful completion with size not equal to 0, malloc() shall + * return a pointer to the allocated space. If size is 0, either a null + * pointer or a unique pointer that can be successfully passed to free() + * shall be returned. Otherwise, it shall return a null pointer and set + * errno to indicate the error." + * + * Consequently, a NULL pointer being returned by `malloc()` for a 0-size + * allocation is *not* to be considered an error. + */ + if (n == 0) return NULL; + + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + rtsConfig.mallocFailHook((W_) n, msg); + stg_exit(EXIT_INTERNAL_ERROR); + } + IF_DEBUG(zero_on_gc, memset(space, 0xbb, n)); + return space; +} + +void +stgFreeAligned (void *p) +{ +#if defined(mingw32_HOST_OS) + _aligned_free(p); +#else + free(p); +#endif +} + /* ----------------------------------------------------------------------------- Stack/heap overflow -------------------------------------------------------------------------- */ ===================================== rts/RtsUtils.h ===================================== @@ -29,16 +29,9 @@ void *stgMallocBytes(size_t n, char *msg) * See: https://gitlab.haskell.org/ghc/ghc/-/issues/22380 */ -void *stgReallocBytes(void *p, size_t n, char *msg) - STG_MALLOC1(stgFree) - STG_ALLOC_SIZE1(2) - STG_RETURNS_NONNULL; -/* Note: `stgRallocBytes` can *not* be tagged as `STG_MALLOC` - * since its return value *can* alias an existing pointer (i.e., - * the given pointer `p`). - * See the documentation of the `malloc` attribute in the GCC manual - * for more information. - */ +void *stgMallocAlignedBytes(size_t n, size_t align, char *msg); + +void *stgReallocBytes(void *p, size_t n, char *msg); void *stgCallocBytes(size_t count, size_t size, char *msg) STG_MALLOC STG_MALLOC1(stgFree) @@ -48,6 +41,10 @@ void *stgCallocBytes(size_t count, size_t size, char *msg) char *stgStrndup(const char *s, size_t n) STG_MALLOC STG_MALLOC1(stgFree); +void *stgMallocAlignedBytes(size_t n, size_t align, char *msg); + +void stgFreeAligned(void *p); + /* ----------------------------------------------------------------------------- * Misc other utilities * -------------------------------------------------------------------------- */ ===================================== testsuite/tests/codeGen/should_compile/T23002.hs ===================================== @@ -0,0 +1,257 @@ +module T23002 + (bfMakeKey, + bfEnc, + bfDec) where + +import Data.Array +import Data.Bits +import Data.Word +import Data.Char + +type Pbox = Array Word32 Word32 +type Sbox = Array Word32 Word32 + +data BF = BF Pbox Sbox Sbox Sbox Sbox + +bfEnc :: BF -> [Word32] -> [Word32] +bfEnc a b = aux a b 0 + where + aux :: BF -> [Word32] -> Word32 -> [Word32] + aux bs@(BF p s0 s1 s2 s3) (l:r:[]) 16 = (r `xor` p!17):(l `xor` p!16):[] + aux bs@(BF p s0 s1 s2 s3) (l:r:[]) i = aux bs (newr:newl:[]) (i+1) + where newl = l `xor` (p ! i) + newr = r `xor` (f newl) + f :: Word32 -> Word32 + f t = ((s0!a + s1!b) `xor` (s2 ! c)) + (s3 ! d) + where a = (t `shiftR` 24) + b = ((t `shiftL` 8) `shiftR` 24) + c = ((t `shiftL` 16) `shiftR` 24) + d = ((t `shiftL` 24) `shiftR` 24) + + +bfDec :: BF -> [Word32] -> [Word32] +bfDec (BF p s0 s1 s2 s3) a = bfEnc (BF (revP p) s0 s1 s2 s3) a + where revP :: Pbox -> Pbox + revP x = x//[(i, x ! (17-i)) | i <- [0..17]] + +bfMakeKey :: [Char] -> BF +bfMakeKey [] = procKey [0,0] (BF iPbox iSbox0 iSbox1 iSbox2 iSbox3) 0 +bfMakeKey k = procKey [0,0] (BF (string2Pbox k) iSbox0 iSbox1 iSbox2 iSbox3) 0 + +string2Pbox :: [Char] -> Pbox +string2Pbox k = array (0,17) [(fromIntegral i,xtext!!i) | i <- [0..17]] + where xtext = zipWith (xor) + (compress4 (doShift (makeTo72 (charsToWord32s k) 0) 0)) + [iPbox ! (fromIntegral i) | i <- [0..17]] + charsToWord32s [] = [] + charsToWord32s (k:ks) = (fromIntegral $ fromEnum k) : charsToWord32s ks + makeTo72 k 72 = [] + makeTo72 k i = k!!(i `mod` (length k)) : makeTo72 k (i+1) + doShift [] i = [] + doShift (w:ws) i = w `shiftL` (8*(3 - (i `mod` 4))) : doShift ws (i+1) + compress4 [] = [] + compress4 (a:b:c:d:etc) = (a .|. b .|. c .|. d) : compress4 etc + +procKey :: [Word32] -> BF -> Word32 -> BF +procKey (l:r:[]) tpbf@(BF p s0 s1 s2 s3) 1042 = tpbf +procKey (l:r:[]) tpbf@(BF p s0 s1 s2 s3) i = procKey [nl,nr] (newbf i) (i+2) + where [nl,nr] = bfEnc tpbf [l,r] + newbf x | x < 18 = (BF (p//[(x,nl),(x+1,nr)]) s0 s1 s2 s3) + | x < 274 = (BF p (s0//[(x-18,nl),(x-17,nr)]) s1 s2 s3) + | x < 530 = (BF p s0 (s1//[(x-274,nl),(x-273,nr)]) s2 s3) + | x < 786 = (BF p s0 s1 (s2//[(x-530,nl),(x-529,nr)]) s3) + | x < 1042 = (BF p s0 s1 s2 (s3//[(x-786,nl),(x-785,nr)])) + + + +---------- INITIAL S AND P BOXES ARE THE HEXADECIMAL DIGITS OF PI ------------ + +iPbox :: Pbox +iPbox = array (0,17) (zip [0..17] + [0x243f6a88, 0x85a308d3, 0x13198a2e, 0x03707344, 0xa4093822, 0x299f31d0, + 0x082efa98, 0xec4e6c89, 0x452821e6, 0x38d01377, 0xbe5466cf, 0x34e90c6c, + 0xc0ac29b7, 0xc97c50dd, 0x3f84d5b5, 0xb5470917, 0x9216d5d9, 0x8979fb1b]) + +iSbox0 :: Sbox +iSbox0 = array (0,255) (zip [0..255] + [0xd1310ba6, 0x98dfb5ac, 0x2ffd72db, 0xd01adfb7, 0xb8e1afed, 0x6a267e96, + 0xba7c9045, 0xf12c7f99, 0x24a19947, 0xb3916cf7, 0x0801f2e2, 0x858efc16, + 0x636920d8, 0x71574e69, 0xa458fea3, 0xf4933d7e, 0x0d95748f, 0x728eb658, + 0x718bcd58, 0x82154aee, 0x7b54a41d, 0xc25a59b5, 0x9c30d539, 0x2af26013, + 0xc5d1b023, 0x286085f0, 0xca417918, 0xb8db38ef, 0x8e79dcb0, 0x603a180e, + 0x6c9e0e8b, 0xb01e8a3e, 0xd71577c1, 0xbd314b27, 0x78af2fda, 0x55605c60, + 0xe65525f3, 0xaa55ab94, 0x57489862, 0x63e81440, 0x55ca396a, 0x2aab10b6, + 0xb4cc5c34, 0x1141e8ce, 0xa15486af, 0x7c72e993, 0xb3ee1411, 0x636fbc2a, + 0x2ba9c55d, 0x741831f6, 0xce5c3e16, 0x9b87931e, 0xafd6ba33, 0x6c24cf5c, + 0x7a325381, 0x28958677, 0x3b8f4898, 0x6b4bb9af, 0xc4bfe81b, 0x66282193, + 0x61d809cc, 0xfb21a991, 0x487cac60, 0x5dec8032, 0xef845d5d, 0xe98575b1, + 0xdc262302, 0xeb651b88, 0x23893e81, 0xd396acc5, 0x0f6d6ff3, 0x83f44239, + 0x2e0b4482, 0xa4842004, 0x69c8f04a, 0x9e1f9b5e, 0x21c66842, 0xf6e96c9a, + 0x670c9c61, 0xabd388f0, 0x6a51a0d2, 0xd8542f68, 0x960fa728, 0xab5133a3, + 0x6eef0b6c, 0x137a3be4, 0xba3bf050, 0x7efb2a98, 0xa1f1651d, 0x39af0176, + 0x66ca593e, 0x82430e88, 0x8cee8619, 0x456f9fb4, 0x7d84a5c3, 0x3b8b5ebe, + 0xe06f75d8, 0x85c12073, 0x401a449f, 0x56c16aa6, 0x4ed3aa62, 0x363f7706, + 0x1bfedf72, 0x429b023d, 0x37d0d724, 0xd00a1248, 0xdb0fead3, 0x49f1c09b, + 0x075372c9, 0x80991b7b, 0x25d479d8, 0xf6e8def7, 0xe3fe501a, 0xb6794c3b, + 0x976ce0bd, 0x04c006ba, 0xc1a94fb6, 0x409f60c4, 0x5e5c9ec2, 0x196a2463, + 0x68fb6faf, 0x3e6c53b5, 0x1339b2eb, 0x3b52ec6f, 0x6dfc511f, 0x9b30952c, + 0xcc814544, 0xaf5ebd09, 0xbee3d004, 0xde334afd, 0x660f2807, 0x192e4bb3, + 0xc0cba857, 0x45c8740f, 0xd20b5f39, 0xb9d3fbdb, 0x5579c0bd, 0x1a60320a, + 0xd6a100c6, 0x402c7279, 0x679f25fe, 0xfb1fa3cc, 0x8ea5e9f8, 0xdb3222f8, + 0x3c7516df, 0xfd616b15, 0x2f501ec8, 0xad0552ab, 0x323db5fa, 0xfd238760, + 0x53317b48, 0x3e00df82, 0x9e5c57bb, 0xca6f8ca0, 0x1a87562e, 0xdf1769db, + 0xd542a8f6, 0x287effc3, 0xac6732c6, 0x8c4f5573, 0x695b27b0, 0xbbca58c8, + 0xe1ffa35d, 0xb8f011a0, 0x10fa3d98, 0xfd2183b8, 0x4afcb56c, 0x2dd1d35b, + 0x9a53e479, 0xb6f84565, 0xd28e49bc, 0x4bfb9790, 0xe1ddf2da, 0xa4cb7e33, + 0x62fb1341, 0xcee4c6e8, 0xef20cada, 0x36774c01, 0xd07e9efe, 0x2bf11fb4, + 0x95dbda4d, 0xae909198, 0xeaad8e71, 0x6b93d5a0, 0xd08ed1d0, 0xafc725e0, + 0x8e3c5b2f, 0x8e7594b7, 0x8ff6e2fb, 0xf2122b64, 0x8888b812, 0x900df01c, + 0x4fad5ea0, 0x688fc31c, 0xd1cff191, 0xb3a8c1ad, 0x2f2f2218, 0xbe0e1777, + 0xea752dfe, 0x8b021fa1, 0xe5a0cc0f, 0xb56f74e8, 0x18acf3d6, 0xce89e299, + 0xb4a84fe0, 0xfd13e0b7, 0x7cc43b81, 0xd2ada8d9, 0x165fa266, 0x80957705, + 0x93cc7314, 0x211a1477, 0xe6ad2065, 0x77b5fa86, 0xc75442f5, 0xfb9d35cf, + 0xebcdaf0c, 0x7b3e89a0, 0xd6411bd3, 0xae1e7e49, 0x00250e2d, 0x2071b35e, + 0x226800bb, 0x57b8e0af, 0x2464369b, 0xf009b91e, 0x5563911d, 0x59dfa6aa, + 0x78c14389, 0xd95a537f, 0x207d5ba2, 0x02e5b9c5, 0x83260376, 0x6295cfa9, + 0x11c81968, 0x4e734a41, 0xb3472dca, 0x7b14a94a, 0x1b510052, 0x9a532915, + 0xd60f573f, 0xbc9bc6e4, 0x2b60a476, 0x81e67400, 0x08ba6fb5, 0x571be91f, + 0xf296ec6b, 0x2a0dd915, 0xb6636521, 0xe7b9f9b6, 0xff34052e, 0xc5855664, + 0x53b02d5d, 0xa99f8fa1, 0x08ba4799, 0x6e85076a]) + +iSbox1 :: Sbox +iSbox1 = array (0,255) (zip [0..255] + [0x4b7a70e9, 0xb5b32944, 0xdb75092e, 0xc4192623, 0xad6ea6b0, 0x49a7df7d, + 0x9cee60b8, 0x8fedb266, 0xecaa8c71, 0x699a17ff, 0x5664526c, 0xc2b19ee1, + 0x193602a5, 0x75094c29, 0xa0591340, 0xe4183a3e, 0x3f54989a, 0x5b429d65, + 0x6b8fe4d6, 0x99f73fd6, 0xa1d29c07, 0xefe830f5, 0x4d2d38e6, 0xf0255dc1, + 0x4cdd2086, 0x8470eb26, 0x6382e9c6, 0x021ecc5e, 0x09686b3f, 0x3ebaefc9, + 0x3c971814, 0x6b6a70a1, 0x687f3584, 0x52a0e286, 0xb79c5305, 0xaa500737, + 0x3e07841c, 0x7fdeae5c, 0x8e7d44ec, 0x5716f2b8, 0xb03ada37, 0xf0500c0d, + 0xf01c1f04, 0x0200b3ff, 0xae0cf51a, 0x3cb574b2, 0x25837a58, 0xdc0921bd, + 0xd19113f9, 0x7ca92ff6, 0x94324773, 0x22f54701, 0x3ae5e581, 0x37c2dadc, + 0xc8b57634, 0x9af3dda7, 0xa9446146, 0x0fd0030e, 0xecc8c73e, 0xa4751e41, + 0xe238cd99, 0x3bea0e2f, 0x3280bba1, 0x183eb331, 0x4e548b38, 0x4f6db908, + 0x6f420d03, 0xf60a04bf, 0x2cb81290, 0x24977c79, 0x5679b072, 0xbcaf89af, + 0xde9a771f, 0xd9930810, 0xb38bae12, 0xdccf3f2e, 0x5512721f, 0x2e6b7124, + 0x501adde6, 0x9f84cd87, 0x7a584718, 0x7408da17, 0xbc9f9abc, 0xe94b7d8c, + 0xec7aec3a, 0xdb851dfa, 0x63094366, 0xc464c3d2, 0xef1c1847, 0x3215d908, + 0xdd433b37, 0x24c2ba16, 0x12a14d43, 0x2a65c451, 0x50940002, 0x133ae4dd, + 0x71dff89e, 0x10314e55, 0x81ac77d6, 0x5f11199b, 0x043556f1, 0xd7a3c76b, + 0x3c11183b, 0x5924a509, 0xf28fe6ed, 0x97f1fbfa, 0x9ebabf2c, 0x1e153c6e, + 0x86e34570, 0xeae96fb1, 0x860e5e0a, 0x5a3e2ab3, 0x771fe71c, 0x4e3d06fa, + 0x2965dcb9, 0x99e71d0f, 0x803e89d6, 0x5266c825, 0x2e4cc978, 0x9c10b36a, + 0xc6150eba, 0x94e2ea78, 0xa5fc3c53, 0x1e0a2df4, 0xf2f74ea7, 0x361d2b3d, + 0x1939260f, 0x19c27960, 0x5223a708, 0xf71312b6, 0xebadfe6e, 0xeac31f66, + 0xe3bc4595, 0xa67bc883, 0xb17f37d1, 0x018cff28, 0xc332ddef, 0xbe6c5aa5, + 0x65582185, 0x68ab9802, 0xeecea50f, 0xdb2f953b, 0x2aef7dad, 0x5b6e2f84, + 0x1521b628, 0x29076170, 0xecdd4775, 0x619f1510, 0x13cca830, 0xeb61bd96, + 0x0334fe1e, 0xaa0363cf, 0xb5735c90, 0x4c70a239, 0xd59e9e0b, 0xcbaade14, + 0xeecc86bc, 0x60622ca7, 0x9cab5cab, 0xb2f3846e, 0x648b1eaf, 0x19bdf0ca, + 0xa02369b9, 0x655abb50, 0x40685a32, 0x3c2ab4b3, 0x319ee9d5, 0xc021b8f7, + 0x9b540b19, 0x875fa099, 0x95f7997e, 0x623d7da8, 0xf837889a, 0x97e32d77, + 0x11ed935f, 0x16681281, 0x0e358829, 0xc7e61fd6, 0x96dedfa1, 0x7858ba99, + 0x57f584a5, 0x1b227263, 0x9b83c3ff, 0x1ac24696, 0xcdb30aeb, 0x532e3054, + 0x8fd948e4, 0x6dbc3128, 0x58ebf2ef, 0x34c6ffea, 0xfe28ed61, 0xee7c3c73, + 0x5d4a14d9, 0xe864b7e3, 0x42105d14, 0x203e13e0, 0x45eee2b6, 0xa3aaabea, + 0xdb6c4f15, 0xfacb4fd0, 0xc742f442, 0xef6abbb5, 0x654f3b1d, 0x41cd2105, + 0xd81e799e, 0x86854dc7, 0xe44b476a, 0x3d816250, 0xcf62a1f2, 0x5b8d2646, + 0xfc8883a0, 0xc1c7b6a3, 0x7f1524c3, 0x69cb7492, 0x47848a0b, 0x5692b285, + 0x095bbf00, 0xad19489d, 0x1462b174, 0x23820e00, 0x58428d2a, 0x0c55f5ea, + 0x1dadf43e, 0x233f7061, 0x3372f092, 0x8d937e41, 0xd65fecf1, 0x6c223bdb, + 0x7cde3759, 0xcbee7460, 0x4085f2a7, 0xce77326e, 0xa6078084, 0x19f8509e, + 0xe8efd855, 0x61d99735, 0xa969a7aa, 0xc50c06c2, 0x5a04abfc, 0x800bcadc, + 0x9e447a2e, 0xc3453484, 0xfdd56705, 0x0e1e9ec9, 0xdb73dbd3, 0x105588cd, + 0x675fda79, 0xe3674340, 0xc5c43465, 0x713e38d8, 0x3d28f89e, 0xf16dff20, + 0x153e21e7, 0x8fb03d4a, 0xe6e39f2b, 0xdb83adf7]) + +iSbox2 :: Sbox +iSbox2 = array (0,255) (zip [0..255] + [0xe93d5a68, 0x948140f7, 0xf64c261c, 0x94692934, 0x411520f7, 0x7602d4f7, + 0xbcf46b2e, 0xd4a20068, 0xd4082471, 0x3320f46a, 0x43b7d4b7, 0x500061af, + 0x1e39f62e, 0x97244546, 0x14214f74, 0xbf8b8840, 0x4d95fc1d, 0x96b591af, + 0x70f4ddd3, 0x66a02f45, 0xbfbc09ec, 0x03bd9785, 0x7fac6dd0, 0x31cb8504, + 0x96eb27b3, 0x55fd3941, 0xda2547e6, 0xabca0a9a, 0x28507825, 0x530429f4, + 0x0a2c86da, 0xe9b66dfb, 0x68dc1462, 0xd7486900, 0x680ec0a4, 0x27a18dee, + 0x4f3ffea2, 0xe887ad8c, 0xb58ce006, 0x7af4d6b6, 0xaace1e7c, 0xd3375fec, + 0xce78a399, 0x406b2a42, 0x20fe9e35, 0xd9f385b9, 0xee39d7ab, 0x3b124e8b, + 0x1dc9faf7, 0x4b6d1856, 0x26a36631, 0xeae397b2, 0x3a6efa74, 0xdd5b4332, + 0x6841e7f7, 0xca7820fb, 0xfb0af54e, 0xd8feb397, 0x454056ac, 0xba489527, + 0x55533a3a, 0x20838d87, 0xfe6ba9b7, 0xd096954b, 0x55a867bc, 0xa1159a58, + 0xcca92963, 0x99e1db33, 0xa62a4a56, 0x3f3125f9, 0x5ef47e1c, 0x9029317c, + 0xfdf8e802, 0x04272f70, 0x80bb155c, 0x05282ce3, 0x95c11548, 0xe4c66d22, + 0x48c1133f, 0xc70f86dc, 0x07f9c9ee, 0x41041f0f, 0x404779a4, 0x5d886e17, + 0x325f51eb, 0xd59bc0d1, 0xf2bcc18f, 0x41113564, 0x257b7834, 0x602a9c60, + 0xdff8e8a3, 0x1f636c1b, 0x0e12b4c2, 0x02e1329e, 0xaf664fd1, 0xcad18115, + 0x6b2395e0, 0x333e92e1, 0x3b240b62, 0xeebeb922, 0x85b2a20e, 0xe6ba0d99, + 0xde720c8c, 0x2da2f728, 0xd0127845, 0x95b794fd, 0x647d0862, 0xe7ccf5f0, + 0x5449a36f, 0x877d48fa, 0xc39dfd27, 0xf33e8d1e, 0x0a476341, 0x992eff74, + 0x3a6f6eab, 0xf4f8fd37, 0xa812dc60, 0xa1ebddf8, 0x991be14c, 0xdb6e6b0d, + 0xc67b5510, 0x6d672c37, 0x2765d43b, 0xdcd0e804, 0xf1290dc7, 0xcc00ffa3, + 0xb5390f92, 0x690fed0b, 0x667b9ffb, 0xcedb7d9c, 0xa091cf0b, 0xd9155ea3, + 0xbb132f88, 0x515bad24, 0x7b9479bf, 0x763bd6eb, 0x37392eb3, 0xcc115979, + 0x8026e297, 0xf42e312d, 0x6842ada7, 0xc66a2b3b, 0x12754ccc, 0x782ef11c, + 0x6a124237, 0xb79251e7, 0x06a1bbe6, 0x4bfb6350, 0x1a6b1018, 0x11caedfa, + 0x3d25bdd8, 0xe2e1c3c9, 0x44421659, 0x0a121386, 0xd90cec6e, 0xd5abea2a, + 0x64af674e, 0xda86a85f, 0xbebfe988, 0x64e4c3fe, 0x9dbc8057, 0xf0f7c086, + 0x60787bf8, 0x6003604d, 0xd1fd8346, 0xf6381fb0, 0x7745ae04, 0xd736fccc, + 0x83426b33, 0xf01eab71, 0xb0804187, 0x3c005e5f, 0x77a057be, 0xbde8ae24, + 0x55464299, 0xbf582e61, 0x4e58f48f, 0xf2ddfda2, 0xf474ef38, 0x8789bdc2, + 0x5366f9c3, 0xc8b38e74, 0xb475f255, 0x46fcd9b9, 0x7aeb2661, 0x8b1ddf84, + 0x846a0e79, 0x915f95e2, 0x466e598e, 0x20b45770, 0x8cd55591, 0xc902de4c, + 0xb90bace1, 0xbb8205d0, 0x11a86248, 0x7574a99e, 0xb77f19b6, 0xe0a9dc09, + 0x662d09a1, 0xc4324633, 0xe85a1f02, 0x09f0be8c, 0x4a99a025, 0x1d6efe10, + 0x1ab93d1d, 0x0ba5a4df, 0xa186f20f, 0x2868f169, 0xdcb7da83, 0x573906fe, + 0xa1e2ce9b, 0x4fcd7f52, 0x50115e01, 0xa70683fa, 0xa002b5c4, 0x0de6d027, + 0x9af88c27, 0x773f8641, 0xc3604c06, 0x61a806b5, 0xf0177a28, 0xc0f586e0, + 0x006058aa, 0x30dc7d62, 0x11e69ed7, 0x2338ea63, 0x53c2dd94, 0xc2c21634, + 0xbbcbee56, 0x90bcb6de, 0xebfc7da1, 0xce591d76, 0x6f05e409, 0x4b7c0188, + 0x39720a3d, 0x7c927c24, 0x86e3725f, 0x724d9db9, 0x1ac15bb4, 0xd39eb8fc, + 0xed545578, 0x08fca5b5, 0xd83d7cd3, 0x4dad0fc4, 0x1e50ef5e, 0xb161e6f8, + 0xa28514d9, 0x6c51133c, 0x6fd5c7e7, 0x56e14ec4, 0x362abfce, 0xddc6c837, + 0xd79a3234, 0x92638212, 0x670efa8e, 0x406000e0]) + +iSbox3 :: Sbox +iSbox3 = array (0,255) (zip [0..255] + [0x3a39ce37, 0xd3faf5cf, 0xabc27737, 0x5ac52d1b, 0x5cb0679e, 0x4fa33742, + 0xd3822740, 0x99bc9bbe, 0xd5118e9d, 0xbf0f7315, 0xd62d1c7e, 0xc700c47b, + 0xb78c1b6b, 0x21a19045, 0xb26eb1be, 0x6a366eb4, 0x5748ab2f, 0xbc946e79, + 0xc6a376d2, 0x6549c2c8, 0x530ff8ee, 0x468dde7d, 0xd5730a1d, 0x4cd04dc6, + 0x2939bbdb, 0xa9ba4650, 0xac9526e8, 0xbe5ee304, 0xa1fad5f0, 0x6a2d519a, + 0x63ef8ce2, 0x9a86ee22, 0xc089c2b8, 0x43242ef6, 0xa51e03aa, 0x9cf2d0a4, + 0x83c061ba, 0x9be96a4d, 0x8fe51550, 0xba645bd6, 0x2826a2f9, 0xa73a3ae1, + 0x4ba99586, 0xef5562e9, 0xc72fefd3, 0xf752f7da, 0x3f046f69, 0x77fa0a59, + 0x80e4a915, 0x87b08601, 0x9b09e6ad, 0x3b3ee593, 0xe990fd5a, 0x9e34d797, + 0x2cf0b7d9, 0x022b8b51, 0x96d5ac3a, 0x017da67d, 0xd1cf3ed6, 0x7c7d2d28, + 0x1f9f25cf, 0xadf2b89b, 0x5ad6b472, 0x5a88f54c, 0xe029ac71, 0xe019a5e6, + 0x47b0acfd, 0xed93fa9b, 0xe8d3c48d, 0x283b57cc, 0xf8d56629, 0x79132e28, + 0x785f0191, 0xed756055, 0xf7960e44, 0xe3d35e8c, 0x15056dd4, 0x88f46dba, + 0x03a16125, 0x0564f0bd, 0xc3eb9e15, 0x3c9057a2, 0x97271aec, 0xa93a072a, + 0x1b3f6d9b, 0x1e6321f5, 0xf59c66fb, 0x26dcf319, 0x7533d928, 0xb155fdf5, + 0x03563482, 0x8aba3cbb, 0x28517711, 0xc20ad9f8, 0xabcc5167, 0xccad925f, + 0x4de81751, 0x3830dc8e, 0x379d5862, 0x9320f991, 0xea7a90c2, 0xfb3e7bce, + 0x5121ce64, 0x774fbe32, 0xa8b6e37e, 0xc3293d46, 0x48de5369, 0x6413e680, + 0xa2ae0810, 0xdd6db224, 0x69852dfd, 0x09072166, 0xb39a460a, 0x6445c0dd, + 0x586cdecf, 0x1c20c8ae, 0x5bbef7dd, 0x1b588d40, 0xccd2017f, 0x6bb4e3bb, + 0xdda26a7e, 0x3a59ff45, 0x3e350a44, 0xbcb4cdd5, 0x72eacea8, 0xfa6484bb, + 0x8d6612ae, 0xbf3c6f47, 0xd29be463, 0x542f5d9e, 0xaec2771b, 0xf64e6370, + 0x740e0d8d, 0xe75b1357, 0xf8721671, 0xaf537d5d, 0x4040cb08, 0x4eb4e2cc, + 0x34d2466a, 0x0115af84, 0xe1b00428, 0x95983a1d, 0x06b89fb4, 0xce6ea048, + 0x6f3f3b82, 0x3520ab82, 0x011a1d4b, 0x277227f8, 0x611560b1, 0xe7933fdc, + 0xbb3a792b, 0x344525bd, 0xa08839e1, 0x51ce794b, 0x2f32c9b7, 0xa01fbac9, + 0xe01cc87e, 0xbcc7d1f6, 0xcf0111c3, 0xa1e8aac7, 0x1a908749, 0xd44fbd9a, + 0xd0dadecb, 0xd50ada38, 0x0339c32a, 0xc6913667, 0x8df9317c, 0xe0b12b4f, + 0xf79e59b7, 0x43f5bb3a, 0xf2d519ff, 0x27d9459c, 0xbf97222c, 0x15e6fc2a, + 0x0f91fc71, 0x9b941525, 0xfae59361, 0xceb69ceb, 0xc2a86459, 0x12baa8d1, + 0xb6c1075e, 0xe3056a0c, 0x10d25065, 0xcb03a442, 0xe0ec6e0e, 0x1698db3b, + 0x4c98a0be, 0x3278e964, 0x9f1f9532, 0xe0d392df, 0xd3a0342b, 0x8971f21e, + 0x1b0a7441, 0x4ba3348c, 0xc5be7120, 0xc37632d8, 0xdf359f8d, 0x9b992f2e, + 0xe60b6f47, 0x0fe3f11d, 0xe54cda54, 0x1edad891, 0xce6279cf, 0xcd3e7e6f, + 0x1618b166, 0xfd2c1d05, 0x848fd2c5, 0xf6fb2299, 0xf523f357, 0xa6327623, + 0x93a83531, 0x56cccd02, 0xacf08162, 0x5a75ebb5, 0x6e163697, 0x88d273cc, + 0xde966292, 0x81b949d0, 0x4c50901b, 0x71c65614, 0xe6c6c7bd, 0x327a140a, + 0x45e1d006, 0xc3f27b9a, 0xc9aa53fd, 0x62a80f00, 0xbb25bfe2, 0x35bdd2f6, + 0x71126905, 0xb2040222, 0xb6cbcf7c, 0xcd769c2b, 0x53113ec0, 0x1640e3d3, + 0x38abbd60, 0x2547adf0, 0xba38209c, 0xf746ce76, 0x77afa1c5, 0x20756060, + 0x85cbfe4e, 0x8ae88dd8, 0x7aaaf9b0, 0x4cf9aa7e, 0x1948c25c, 0x02fb8a8c, + 0x01c36ae4, 0xd6ebe1f9, 0x90d4f869, 0xa65cdea0, 0x3f09252d, 0xc208e69f, + 0xb74e6132, 0xce77e25b, 0x578fdfe3, 0x3ac372e6]) ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -127,3 +127,4 @@ test('T21710a', [ unless(tables_next_to_code(), skip) , when(wordsize(32), skip) , only_ways(['optasm']) , grep_errmsg('(call)',[1]) ] , compile, ['-ddump-cmm -dno-typeable-binds']) +test('T23002', normal, compile, ['-fregs-graph']) ===================================== testsuite/tests/ffi/should_compile/T22774.hs ===================================== @@ -0,0 +1,4 @@ +module T22774 where + +foreign import javascript foo :: IO () + ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -44,3 +44,6 @@ test( ) test('T15531', normal, compile, ['-Wall']) test('T22043', [omit_ways(['ghci'])], compile, ['']) + +test('T22774', when(not js_arch(), expect_fail), compile, ['']) + ===================================== testsuite/tests/numeric/should_compile/T23019.hs ===================================== @@ -0,0 +1,21 @@ +module T23019 + ( + eexponent + ) where + +-- spine lazy, value strict list of doubles +data List + = Nil + | {-# UNPACK #-} !Double :! List + +infixr 5 :! + +newtype TowerDouble = Tower { getTower :: List } + +primal :: TowerDouble -> Double +primal (Tower (x:!_)) = x +primal _ = 0 + +eexponent :: TowerDouble -> Int +eexponent = exponent . primal + ===================================== testsuite/tests/numeric/should_compile/all.T ===================================== @@ -19,3 +19,4 @@ test('T20347', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-b test('T20448', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T19641', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T15547', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) +test('T23019', normal, compile, ['-O']) ===================================== testsuite/tests/typecheck/should_fail/T22707.hs ===================================== @@ -0,0 +1,22 @@ +module T22707 where + +newtype Cont o i a = Cont {runCont ::(a -> i) -> o } + +t1:: Cont (i2 -> o) i1 a -> Cont o i2 (a -> i1) +t1 c = Cont $ \ati1tti2 -> (runCont c) (ati1tti2 $ \a -> evalCont (t1 c) >>== \ati1 -> return ati1 a ) + +evalCont:: Cont o a a -> o +evalCont c = (runCont c)id + +instance Monad (Cont p p) where + return a = Cont ($ a) + (>>=) = (>>==) + +class PMonad m where + (>>==):: m p q a -> (a -> m q r b) -> m p r b + +instance PMonad Cont where + (Cont cont) >>== afmb = Cont $ \bti -> cont $ \a -> (runCont . afmb) a bti + +main:: IO () +main = putStrLn "bug" ===================================== testsuite/tests/typecheck/should_fail/T22707.stderr ===================================== @@ -0,0 +1,16 @@ + +T22707.hs:6:37: error: [GHC-18872] + • Couldn't match kind ‘*’ with ‘GHC.Types.RuntimeRep’ + When matching types + p0 :: * + GHC.Types.LiftedRep :: GHC.Types.RuntimeRep + Expected: Cont o i1 a + Actual: Cont (i2 -> o) i1 a + • In the first argument of ‘runCont’, namely ‘c’ + In the expression: + (runCont c) + (ati1tti2 $ \ a -> evalCont (t1 c) >>== \ ati1 -> return ati1 a) + In the second argument of ‘($)’, namely + ‘\ ati1tti2 + -> (runCont c) + (ati1tti2 $ \ a -> evalCont (t1 c) >>== \ ati1 -> ...)’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -321,6 +321,7 @@ test('T7856', normal, compile_fail, ['']) test('T7869', normal, compile_fail, ['']) test('T7892', normal, compile_fail, ['']) test('T7809', normal, compile_fail, ['']) +test('T22707', normal, compile_fail, ['']) test('T7989', normal, compile_fail, ['']) test('T8034', normal, compile_fail, ['']) test('T8142', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a44834b17ba3d01133ffa7b1bf6de6bf92fdd3c7...3148604ebb3d6c21e6710943757b8b548292fe46 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a44834b17ba3d01133ffa7b1bf6de6bf92fdd3c7...3148604ebb3d6c21e6710943757b8b548292fe46 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 19:41:29 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 02 Mar 2023 14:41:29 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/hdoc-llvm-workaround Message-ID: <6400fbe9b6f0d_3ab52b51d484018277e@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/hdoc-llvm-workaround at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hdoc-llvm-workaround You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 2 23:12:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Mar 2023 18:12:11 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Don't suppress *all* Wanteds Message-ID: <64012d4b82d56_3ab52b91135b0286955@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6212af1a by Richard Eisenberg at 2023-03-02T18:11:53-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 4d3d3cec by Luite Stegeman at 2023-03-02T18:11:54-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - 7730a0d6 by Ben Gamari at 2023-03-02T18:11:55-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 0fc39db0 by Ben Gamari at 2023-03-02T18:11:55-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8244522e by Ben Gamari at 2023-03-02T18:11:55-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - d717ec01 by Ben Gamari at 2023-03-02T18:11:55-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - fa1056ab by Matthew Pickering at 2023-03-02T18:11:56-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 52b937c7 by Zubin Duggal at 2023-03-02T18:11:56-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - bc9615a4 by Simon Peyton Jones at 2023-03-02T18:11:57-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 21 changed files: - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Types/Constraint.hs - rts/Capability.c - rts/Capability.h - rts/RtsUtils.c - rts/RtsUtils.h - + testsuite/tests/codeGen/should_compile/T23002.hs - testsuite/tests/codeGen/should_compile/all.T - + testsuite/tests/ffi/should_compile/T22774.hs - testsuite/tests/ffi/should_compile/all.T - + testsuite/tests/numeric/should_compile/T23019.hs - testsuite/tests/numeric/should_compile/all.T - + testsuite/tests/simplCore/should_compile/T23026.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T22707.hs - + testsuite/tests/typecheck/should_fail/T22707.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -73,6 +73,7 @@ regUsageOfInstr :: Platform -> Instr -> RegUsage regUsageOfInstr platform instr = case instr of ANN _ i -> regUsageOfInstr platform i COMMENT{} -> usage ([], []) + MULTILINE_COMMENT{} -> usage ([], []) PUSH_STACK_FRAME -> usage ([], []) POP_STACK_FRAME -> usage ([], []) DELTA{} -> usage ([], []) @@ -207,11 +208,12 @@ callerSavedRegisters patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr patchRegsOfInstr instr env = case instr of -- 0. Meta Instructions - ANN d i -> ANN d (patchRegsOfInstr i env) - COMMENT{} -> instr - PUSH_STACK_FRAME -> instr - POP_STACK_FRAME -> instr - DELTA{} -> instr + ANN d i -> ANN d (patchRegsOfInstr i env) + COMMENT{} -> instr + MULTILINE_COMMENT{} -> instr + PUSH_STACK_FRAME -> instr + POP_STACK_FRAME -> instr + DELTA{} -> instr -- 1. Arithmetic Instructions ---------------------------------------------- ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3105,7 +3105,7 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs -- Adds as many binders as asked for; assumes expr is not a lambda etaBodyForJoinPoint :: Int -> CoreExpr -> ([CoreBndr], CoreExpr) etaBodyForJoinPoint need_args body - = go need_args (exprType body) (init_subst body) [] body + = go need_args body_ty (mkEmptySubst in_scope) [] body where go 0 _ _ rev_bs e = (reverse rev_bs, e) @@ -3124,9 +3124,16 @@ etaBodyForJoinPoint need_args body = pprPanic "etaBodyForJoinPoint" $ int need_args $$ ppr body $$ ppr (exprType body) - init_subst e = mkEmptySubst (mkInScopeSet (exprFreeVars e)) - - + body_ty = exprType body + in_scope = mkInScopeSet (exprFreeVars body `unionVarSet` tyCoVarsOfType body_ty) + -- in_scope is a bit tricky. + -- - We are wrapping `body` in some value lambdas, so must not shadow + -- any free vars of `body` + -- - We are wrapping `body` in some type lambdas, so must not shadow any + -- tyvars in body_ty. Example: body is just a variable + -- (g :: forall (a::k). T k a -> Int) + -- We must not shadown that `k` when adding the /\a. So treat the free vars + -- of body_ty as in-scope. Showed up in #23026. -------------- freshEtaId :: Int -> Subst -> Scaled Type -> (Subst, Id) ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -1110,14 +1110,10 @@ doubleOp2 _ _ _ _ = Nothing -------------------------- doubleDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr doubleDecodeOp env (LitDouble ((decodeFloat . fromRational @Double) -> (m, e))) - = Just $ mkCoreUnboxedTuple [ Lit (mkLitINT64 (toInteger m)) + = Just $ mkCoreUnboxedTuple [ Lit (mkLitInt64Wrap (toInteger m)) , mkIntVal platform (toInteger e) ] where platform = roPlatform env - mkLitINT64 | platformWordSizeInBits platform < 64 - = mkLitInt64Wrap - | otherwise - = mkLitIntWrap platform doubleDecodeOp _ _ = Nothing ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -476,30 +476,37 @@ mkErrorItem ct , ei_m_reason = m_reason , ei_suppress = suppress }} +-- | Actually report this 'ErrorItem'. +unsuppressErrorItem :: ErrorItem -> ErrorItem +unsuppressErrorItem ei = ei { ei_suppress = False } + ---------------------------------------------------------------- reportWanteds :: SolverReportErrCtxt -> TcLevel -> WantedConstraints -> TcM () reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics , wc_errors = errs }) | isEmptyWC wc = traceTc "reportWanteds empty WC" empty | otherwise - = do { tidy_items <- mapMaybeM mkErrorItem tidy_cts + = do { tidy_items1 <- mapMaybeM mkErrorItem tidy_cts ; traceTc "reportWanteds 1" (vcat [ text "Simples =" <+> ppr simples , text "Suppress =" <+> ppr (cec_suppress ctxt) , text "tidy_cts =" <+> ppr tidy_cts - , text "tidy_items =" <+> ppr tidy_items + , text "tidy_items1 =" <+> ppr tidy_items1 , text "tidy_errs =" <+> ppr tidy_errs ]) - -- This check makes sure that we aren't suppressing the only error that will - -- actually stop compilation - ; assertPprM - ( do { errs_already <- ifErrsM (return True) (return False) - ; return $ - errs_already || -- we already reported an error (perhaps from an outer implication) - null simples || -- no errors to report here - any ignoreConstraint simples || -- one error is ignorable (is reported elsewhere) - not (all ei_suppress tidy_items) -- not all errors are suppressed - } ) - (vcat [text "reportWanteds is suppressing all errors"]) + -- Catch an awkward case in which /all/ errors are suppressed: + -- see Wrinkle at end of Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint + -- Unless we are sure that an error will be reported some other way (details + -- in the defn of tidy_items) un-suppress the lot. This makes sure we don't forget to + -- report an error at all, which is catastrophic: GHC proceeds to desguar and optimise + -- the program, even though it is full of type errors (#22702, #22793) + ; errs_already <- ifErrsM (return True) (return False) + ; let tidy_items + | not errs_already -- Have not already reported an error (perhaps + -- from an outer implication); see #21405 + , not (any ignoreConstraint simples) -- No error is ignorable (is reported elsewhere) + , all ei_suppress tidy_items1 -- All errors are suppressed + = map unsuppressErrorItem tidy_items1 + | otherwise = tidy_items1 -- First, deal with any out-of-scope errors: ; let (out_of_scope, other_holes, not_conc_errs) = partition_errors tidy_errs ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -341,9 +341,10 @@ tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) (L ls safety) mh checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty return (CImport src (L lc cconv) (L ls safety) mh (CFunction target)) | cconv == JavaScriptCallConv = do + cconv' <- checkCConv (Right idecl) cconv checkCg (Right idecl) backendValidityOfCImport -- leave the rest to the JS backend (at least for now) - return (CImport src (L lc cconv) (L ls safety) mh (CFunction target)) + return (CImport src (L lc cconv') (L ls safety) mh (CFunction target)) | otherwise = do -- Normal foreign import checkCg (Right idecl) backendValidityOfCImport cconv' <- checkCConv (Right idecl) cconv ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -2127,10 +2127,10 @@ uses GHC.Tc.Utils.anyUnfilledCoercionHoles to look through any filled coercion holes. The idea is that we wish to report the "root cause" -- the error that rewrote all the others. -Worry: It seems possible that *all* unsolved wanteds are rewritten by other -unsolved wanteds, so that e.g. w1 has w2 in its rewriter set, and w2 has -w1 in its rewiter set. We are unable to come up with an example of this in -practice, however, and so we believe this case cannot happen. +Wrinkle: In #22707, we have a case where all of the Wanteds have rewritten +each other. In order to report /some/ error in this case, we simply report +all the Wanteds. The user will get a perhaps-confusing error message, but +they've written a confusing program! Note [Avoiding rewriting cycles] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== rts/Capability.c ===================================== @@ -438,8 +438,9 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS) { for (uint32_t i = 0; i < to; i++) { if (i >= from) { - capabilities[i] = stgMallocBytes(sizeof(Capability), - "moreCapabilities"); + capabilities[i] = stgMallocAlignedBytes(sizeof(Capability), + CAPABILITY_ALIGNMENT, + "moreCapabilities"); initCapability(capabilities[i], i); } } @@ -1274,7 +1275,7 @@ freeCapabilities (void) Capability *cap = getCapability(i); freeCapability(cap); if (cap != &MainCapability) { - stgFree(cap); + stgFreeAligned(cap); } } #else ===================================== rts/Capability.h ===================================== @@ -28,6 +28,14 @@ #include "BeginPrivate.h" +// We never want a Capability to overlap a cache line with +// anything else, so round it up to a cache line size: +#if defined(s390x_HOST_ARCH) +#define CAPABILITY_ALIGNMENT 256 +#else +#define CAPABILITY_ALIGNMENT 64 +#endif + /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */ struct Capability_ { // State required by the STG virtual machine when running Haskell @@ -169,14 +177,12 @@ struct Capability_ { StgTRecHeader *free_trec_headers; uint32_t transaction_tokens; } // typedef Capability is defined in RtsAPI.h - // We never want a Capability to overlap a cache line with anything - // else, so round it up to a cache line size: -#if defined(s390x_HOST_ARCH) - ATTRIBUTE_ALIGNED(256) -#elif !defined(mingw32_HOST_OS) - ATTRIBUTE_ALIGNED(64) -#endif - ; + ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT) +; + +// We allocate arrays of Capabilities therefore we must ensure that the size is +// a multiple of the claimed alignment +GHC_STATIC_ASSERT(sizeof(struct Capability_) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size"); #if defined(THREADED_RTS) #define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId()) ===================================== rts/RtsUtils.c ===================================== @@ -57,9 +57,9 @@ extern char *ctime_r(const time_t *, char *); void * stgMallocBytes (size_t n, char *msg) { - void *space; + void *space = malloc(n); - if ((space = malloc(n)) == NULL) { + if (space == NULL) { /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): * * "Upon successful completion with size not equal to 0, malloc() shall @@ -128,6 +128,53 @@ stgFree(void* p) free(p); } +// N.B. Allocations resulting from this function must be freed by +// `stgFreeAligned`, not `stgFree`. This is necessary due to the properties of Windows' `_aligned_malloc` +void * +stgMallocAlignedBytes (size_t n, size_t align, char *msg) +{ + void *space; + +#if defined(mingw32_HOST_OS) + space = _aligned_malloc(n, align); +#else + if (posix_memalign(&space, align, n)) { + space = NULL; // Allocation failed + } +#endif + + if (space == NULL) { + /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): + * + * "Upon successful completion with size not equal to 0, malloc() shall + * return a pointer to the allocated space. If size is 0, either a null + * pointer or a unique pointer that can be successfully passed to free() + * shall be returned. Otherwise, it shall return a null pointer and set + * errno to indicate the error." + * + * Consequently, a NULL pointer being returned by `malloc()` for a 0-size + * allocation is *not* to be considered an error. + */ + if (n == 0) return NULL; + + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + rtsConfig.mallocFailHook((W_) n, msg); + stg_exit(EXIT_INTERNAL_ERROR); + } + IF_DEBUG(zero_on_gc, memset(space, 0xbb, n)); + return space; +} + +void +stgFreeAligned (void *p) +{ +#if defined(mingw32_HOST_OS) + _aligned_free(p); +#else + free(p); +#endif +} + /* ----------------------------------------------------------------------------- Stack/heap overflow -------------------------------------------------------------------------- */ ===================================== rts/RtsUtils.h ===================================== @@ -29,16 +29,9 @@ void *stgMallocBytes(size_t n, char *msg) * See: https://gitlab.haskell.org/ghc/ghc/-/issues/22380 */ -void *stgReallocBytes(void *p, size_t n, char *msg) - STG_MALLOC1(stgFree) - STG_ALLOC_SIZE1(2) - STG_RETURNS_NONNULL; -/* Note: `stgRallocBytes` can *not* be tagged as `STG_MALLOC` - * since its return value *can* alias an existing pointer (i.e., - * the given pointer `p`). - * See the documentation of the `malloc` attribute in the GCC manual - * for more information. - */ +void *stgMallocAlignedBytes(size_t n, size_t align, char *msg); + +void *stgReallocBytes(void *p, size_t n, char *msg); void *stgCallocBytes(size_t count, size_t size, char *msg) STG_MALLOC STG_MALLOC1(stgFree) @@ -48,6 +41,10 @@ void *stgCallocBytes(size_t count, size_t size, char *msg) char *stgStrndup(const char *s, size_t n) STG_MALLOC STG_MALLOC1(stgFree); +void *stgMallocAlignedBytes(size_t n, size_t align, char *msg); + +void stgFreeAligned(void *p); + /* ----------------------------------------------------------------------------- * Misc other utilities * -------------------------------------------------------------------------- */ ===================================== testsuite/tests/codeGen/should_compile/T23002.hs ===================================== @@ -0,0 +1,257 @@ +module T23002 + (bfMakeKey, + bfEnc, + bfDec) where + +import Data.Array +import Data.Bits +import Data.Word +import Data.Char + +type Pbox = Array Word32 Word32 +type Sbox = Array Word32 Word32 + +data BF = BF Pbox Sbox Sbox Sbox Sbox + +bfEnc :: BF -> [Word32] -> [Word32] +bfEnc a b = aux a b 0 + where + aux :: BF -> [Word32] -> Word32 -> [Word32] + aux bs@(BF p s0 s1 s2 s3) (l:r:[]) 16 = (r `xor` p!17):(l `xor` p!16):[] + aux bs@(BF p s0 s1 s2 s3) (l:r:[]) i = aux bs (newr:newl:[]) (i+1) + where newl = l `xor` (p ! i) + newr = r `xor` (f newl) + f :: Word32 -> Word32 + f t = ((s0!a + s1!b) `xor` (s2 ! c)) + (s3 ! d) + where a = (t `shiftR` 24) + b = ((t `shiftL` 8) `shiftR` 24) + c = ((t `shiftL` 16) `shiftR` 24) + d = ((t `shiftL` 24) `shiftR` 24) + + +bfDec :: BF -> [Word32] -> [Word32] +bfDec (BF p s0 s1 s2 s3) a = bfEnc (BF (revP p) s0 s1 s2 s3) a + where revP :: Pbox -> Pbox + revP x = x//[(i, x ! (17-i)) | i <- [0..17]] + +bfMakeKey :: [Char] -> BF +bfMakeKey [] = procKey [0,0] (BF iPbox iSbox0 iSbox1 iSbox2 iSbox3) 0 +bfMakeKey k = procKey [0,0] (BF (string2Pbox k) iSbox0 iSbox1 iSbox2 iSbox3) 0 + +string2Pbox :: [Char] -> Pbox +string2Pbox k = array (0,17) [(fromIntegral i,xtext!!i) | i <- [0..17]] + where xtext = zipWith (xor) + (compress4 (doShift (makeTo72 (charsToWord32s k) 0) 0)) + [iPbox ! (fromIntegral i) | i <- [0..17]] + charsToWord32s [] = [] + charsToWord32s (k:ks) = (fromIntegral $ fromEnum k) : charsToWord32s ks + makeTo72 k 72 = [] + makeTo72 k i = k!!(i `mod` (length k)) : makeTo72 k (i+1) + doShift [] i = [] + doShift (w:ws) i = w `shiftL` (8*(3 - (i `mod` 4))) : doShift ws (i+1) + compress4 [] = [] + compress4 (a:b:c:d:etc) = (a .|. b .|. c .|. d) : compress4 etc + +procKey :: [Word32] -> BF -> Word32 -> BF +procKey (l:r:[]) tpbf@(BF p s0 s1 s2 s3) 1042 = tpbf +procKey (l:r:[]) tpbf@(BF p s0 s1 s2 s3) i = procKey [nl,nr] (newbf i) (i+2) + where [nl,nr] = bfEnc tpbf [l,r] + newbf x | x < 18 = (BF (p//[(x,nl),(x+1,nr)]) s0 s1 s2 s3) + | x < 274 = (BF p (s0//[(x-18,nl),(x-17,nr)]) s1 s2 s3) + | x < 530 = (BF p s0 (s1//[(x-274,nl),(x-273,nr)]) s2 s3) + | x < 786 = (BF p s0 s1 (s2//[(x-530,nl),(x-529,nr)]) s3) + | x < 1042 = (BF p s0 s1 s2 (s3//[(x-786,nl),(x-785,nr)])) + + + +---------- INITIAL S AND P BOXES ARE THE HEXADECIMAL DIGITS OF PI ------------ + +iPbox :: Pbox +iPbox = array (0,17) (zip [0..17] + [0x243f6a88, 0x85a308d3, 0x13198a2e, 0x03707344, 0xa4093822, 0x299f31d0, + 0x082efa98, 0xec4e6c89, 0x452821e6, 0x38d01377, 0xbe5466cf, 0x34e90c6c, + 0xc0ac29b7, 0xc97c50dd, 0x3f84d5b5, 0xb5470917, 0x9216d5d9, 0x8979fb1b]) + +iSbox0 :: Sbox +iSbox0 = array (0,255) (zip [0..255] + [0xd1310ba6, 0x98dfb5ac, 0x2ffd72db, 0xd01adfb7, 0xb8e1afed, 0x6a267e96, + 0xba7c9045, 0xf12c7f99, 0x24a19947, 0xb3916cf7, 0x0801f2e2, 0x858efc16, + 0x636920d8, 0x71574e69, 0xa458fea3, 0xf4933d7e, 0x0d95748f, 0x728eb658, + 0x718bcd58, 0x82154aee, 0x7b54a41d, 0xc25a59b5, 0x9c30d539, 0x2af26013, + 0xc5d1b023, 0x286085f0, 0xca417918, 0xb8db38ef, 0x8e79dcb0, 0x603a180e, + 0x6c9e0e8b, 0xb01e8a3e, 0xd71577c1, 0xbd314b27, 0x78af2fda, 0x55605c60, + 0xe65525f3, 0xaa55ab94, 0x57489862, 0x63e81440, 0x55ca396a, 0x2aab10b6, + 0xb4cc5c34, 0x1141e8ce, 0xa15486af, 0x7c72e993, 0xb3ee1411, 0x636fbc2a, + 0x2ba9c55d, 0x741831f6, 0xce5c3e16, 0x9b87931e, 0xafd6ba33, 0x6c24cf5c, + 0x7a325381, 0x28958677, 0x3b8f4898, 0x6b4bb9af, 0xc4bfe81b, 0x66282193, + 0x61d809cc, 0xfb21a991, 0x487cac60, 0x5dec8032, 0xef845d5d, 0xe98575b1, + 0xdc262302, 0xeb651b88, 0x23893e81, 0xd396acc5, 0x0f6d6ff3, 0x83f44239, + 0x2e0b4482, 0xa4842004, 0x69c8f04a, 0x9e1f9b5e, 0x21c66842, 0xf6e96c9a, + 0x670c9c61, 0xabd388f0, 0x6a51a0d2, 0xd8542f68, 0x960fa728, 0xab5133a3, + 0x6eef0b6c, 0x137a3be4, 0xba3bf050, 0x7efb2a98, 0xa1f1651d, 0x39af0176, + 0x66ca593e, 0x82430e88, 0x8cee8619, 0x456f9fb4, 0x7d84a5c3, 0x3b8b5ebe, + 0xe06f75d8, 0x85c12073, 0x401a449f, 0x56c16aa6, 0x4ed3aa62, 0x363f7706, + 0x1bfedf72, 0x429b023d, 0x37d0d724, 0xd00a1248, 0xdb0fead3, 0x49f1c09b, + 0x075372c9, 0x80991b7b, 0x25d479d8, 0xf6e8def7, 0xe3fe501a, 0xb6794c3b, + 0x976ce0bd, 0x04c006ba, 0xc1a94fb6, 0x409f60c4, 0x5e5c9ec2, 0x196a2463, + 0x68fb6faf, 0x3e6c53b5, 0x1339b2eb, 0x3b52ec6f, 0x6dfc511f, 0x9b30952c, + 0xcc814544, 0xaf5ebd09, 0xbee3d004, 0xde334afd, 0x660f2807, 0x192e4bb3, + 0xc0cba857, 0x45c8740f, 0xd20b5f39, 0xb9d3fbdb, 0x5579c0bd, 0x1a60320a, + 0xd6a100c6, 0x402c7279, 0x679f25fe, 0xfb1fa3cc, 0x8ea5e9f8, 0xdb3222f8, + 0x3c7516df, 0xfd616b15, 0x2f501ec8, 0xad0552ab, 0x323db5fa, 0xfd238760, + 0x53317b48, 0x3e00df82, 0x9e5c57bb, 0xca6f8ca0, 0x1a87562e, 0xdf1769db, + 0xd542a8f6, 0x287effc3, 0xac6732c6, 0x8c4f5573, 0x695b27b0, 0xbbca58c8, + 0xe1ffa35d, 0xb8f011a0, 0x10fa3d98, 0xfd2183b8, 0x4afcb56c, 0x2dd1d35b, + 0x9a53e479, 0xb6f84565, 0xd28e49bc, 0x4bfb9790, 0xe1ddf2da, 0xa4cb7e33, + 0x62fb1341, 0xcee4c6e8, 0xef20cada, 0x36774c01, 0xd07e9efe, 0x2bf11fb4, + 0x95dbda4d, 0xae909198, 0xeaad8e71, 0x6b93d5a0, 0xd08ed1d0, 0xafc725e0, + 0x8e3c5b2f, 0x8e7594b7, 0x8ff6e2fb, 0xf2122b64, 0x8888b812, 0x900df01c, + 0x4fad5ea0, 0x688fc31c, 0xd1cff191, 0xb3a8c1ad, 0x2f2f2218, 0xbe0e1777, + 0xea752dfe, 0x8b021fa1, 0xe5a0cc0f, 0xb56f74e8, 0x18acf3d6, 0xce89e299, + 0xb4a84fe0, 0xfd13e0b7, 0x7cc43b81, 0xd2ada8d9, 0x165fa266, 0x80957705, + 0x93cc7314, 0x211a1477, 0xe6ad2065, 0x77b5fa86, 0xc75442f5, 0xfb9d35cf, + 0xebcdaf0c, 0x7b3e89a0, 0xd6411bd3, 0xae1e7e49, 0x00250e2d, 0x2071b35e, + 0x226800bb, 0x57b8e0af, 0x2464369b, 0xf009b91e, 0x5563911d, 0x59dfa6aa, + 0x78c14389, 0xd95a537f, 0x207d5ba2, 0x02e5b9c5, 0x83260376, 0x6295cfa9, + 0x11c81968, 0x4e734a41, 0xb3472dca, 0x7b14a94a, 0x1b510052, 0x9a532915, + 0xd60f573f, 0xbc9bc6e4, 0x2b60a476, 0x81e67400, 0x08ba6fb5, 0x571be91f, + 0xf296ec6b, 0x2a0dd915, 0xb6636521, 0xe7b9f9b6, 0xff34052e, 0xc5855664, + 0x53b02d5d, 0xa99f8fa1, 0x08ba4799, 0x6e85076a]) + +iSbox1 :: Sbox +iSbox1 = array (0,255) (zip [0..255] + [0x4b7a70e9, 0xb5b32944, 0xdb75092e, 0xc4192623, 0xad6ea6b0, 0x49a7df7d, + 0x9cee60b8, 0x8fedb266, 0xecaa8c71, 0x699a17ff, 0x5664526c, 0xc2b19ee1, + 0x193602a5, 0x75094c29, 0xa0591340, 0xe4183a3e, 0x3f54989a, 0x5b429d65, + 0x6b8fe4d6, 0x99f73fd6, 0xa1d29c07, 0xefe830f5, 0x4d2d38e6, 0xf0255dc1, + 0x4cdd2086, 0x8470eb26, 0x6382e9c6, 0x021ecc5e, 0x09686b3f, 0x3ebaefc9, + 0x3c971814, 0x6b6a70a1, 0x687f3584, 0x52a0e286, 0xb79c5305, 0xaa500737, + 0x3e07841c, 0x7fdeae5c, 0x8e7d44ec, 0x5716f2b8, 0xb03ada37, 0xf0500c0d, + 0xf01c1f04, 0x0200b3ff, 0xae0cf51a, 0x3cb574b2, 0x25837a58, 0xdc0921bd, + 0xd19113f9, 0x7ca92ff6, 0x94324773, 0x22f54701, 0x3ae5e581, 0x37c2dadc, + 0xc8b57634, 0x9af3dda7, 0xa9446146, 0x0fd0030e, 0xecc8c73e, 0xa4751e41, + 0xe238cd99, 0x3bea0e2f, 0x3280bba1, 0x183eb331, 0x4e548b38, 0x4f6db908, + 0x6f420d03, 0xf60a04bf, 0x2cb81290, 0x24977c79, 0x5679b072, 0xbcaf89af, + 0xde9a771f, 0xd9930810, 0xb38bae12, 0xdccf3f2e, 0x5512721f, 0x2e6b7124, + 0x501adde6, 0x9f84cd87, 0x7a584718, 0x7408da17, 0xbc9f9abc, 0xe94b7d8c, + 0xec7aec3a, 0xdb851dfa, 0x63094366, 0xc464c3d2, 0xef1c1847, 0x3215d908, + 0xdd433b37, 0x24c2ba16, 0x12a14d43, 0x2a65c451, 0x50940002, 0x133ae4dd, + 0x71dff89e, 0x10314e55, 0x81ac77d6, 0x5f11199b, 0x043556f1, 0xd7a3c76b, + 0x3c11183b, 0x5924a509, 0xf28fe6ed, 0x97f1fbfa, 0x9ebabf2c, 0x1e153c6e, + 0x86e34570, 0xeae96fb1, 0x860e5e0a, 0x5a3e2ab3, 0x771fe71c, 0x4e3d06fa, + 0x2965dcb9, 0x99e71d0f, 0x803e89d6, 0x5266c825, 0x2e4cc978, 0x9c10b36a, + 0xc6150eba, 0x94e2ea78, 0xa5fc3c53, 0x1e0a2df4, 0xf2f74ea7, 0x361d2b3d, + 0x1939260f, 0x19c27960, 0x5223a708, 0xf71312b6, 0xebadfe6e, 0xeac31f66, + 0xe3bc4595, 0xa67bc883, 0xb17f37d1, 0x018cff28, 0xc332ddef, 0xbe6c5aa5, + 0x65582185, 0x68ab9802, 0xeecea50f, 0xdb2f953b, 0x2aef7dad, 0x5b6e2f84, + 0x1521b628, 0x29076170, 0xecdd4775, 0x619f1510, 0x13cca830, 0xeb61bd96, + 0x0334fe1e, 0xaa0363cf, 0xb5735c90, 0x4c70a239, 0xd59e9e0b, 0xcbaade14, + 0xeecc86bc, 0x60622ca7, 0x9cab5cab, 0xb2f3846e, 0x648b1eaf, 0x19bdf0ca, + 0xa02369b9, 0x655abb50, 0x40685a32, 0x3c2ab4b3, 0x319ee9d5, 0xc021b8f7, + 0x9b540b19, 0x875fa099, 0x95f7997e, 0x623d7da8, 0xf837889a, 0x97e32d77, + 0x11ed935f, 0x16681281, 0x0e358829, 0xc7e61fd6, 0x96dedfa1, 0x7858ba99, + 0x57f584a5, 0x1b227263, 0x9b83c3ff, 0x1ac24696, 0xcdb30aeb, 0x532e3054, + 0x8fd948e4, 0x6dbc3128, 0x58ebf2ef, 0x34c6ffea, 0xfe28ed61, 0xee7c3c73, + 0x5d4a14d9, 0xe864b7e3, 0x42105d14, 0x203e13e0, 0x45eee2b6, 0xa3aaabea, + 0xdb6c4f15, 0xfacb4fd0, 0xc742f442, 0xef6abbb5, 0x654f3b1d, 0x41cd2105, + 0xd81e799e, 0x86854dc7, 0xe44b476a, 0x3d816250, 0xcf62a1f2, 0x5b8d2646, + 0xfc8883a0, 0xc1c7b6a3, 0x7f1524c3, 0x69cb7492, 0x47848a0b, 0x5692b285, + 0x095bbf00, 0xad19489d, 0x1462b174, 0x23820e00, 0x58428d2a, 0x0c55f5ea, + 0x1dadf43e, 0x233f7061, 0x3372f092, 0x8d937e41, 0xd65fecf1, 0x6c223bdb, + 0x7cde3759, 0xcbee7460, 0x4085f2a7, 0xce77326e, 0xa6078084, 0x19f8509e, + 0xe8efd855, 0x61d99735, 0xa969a7aa, 0xc50c06c2, 0x5a04abfc, 0x800bcadc, + 0x9e447a2e, 0xc3453484, 0xfdd56705, 0x0e1e9ec9, 0xdb73dbd3, 0x105588cd, + 0x675fda79, 0xe3674340, 0xc5c43465, 0x713e38d8, 0x3d28f89e, 0xf16dff20, + 0x153e21e7, 0x8fb03d4a, 0xe6e39f2b, 0xdb83adf7]) + +iSbox2 :: Sbox +iSbox2 = array (0,255) (zip [0..255] + [0xe93d5a68, 0x948140f7, 0xf64c261c, 0x94692934, 0x411520f7, 0x7602d4f7, + 0xbcf46b2e, 0xd4a20068, 0xd4082471, 0x3320f46a, 0x43b7d4b7, 0x500061af, + 0x1e39f62e, 0x97244546, 0x14214f74, 0xbf8b8840, 0x4d95fc1d, 0x96b591af, + 0x70f4ddd3, 0x66a02f45, 0xbfbc09ec, 0x03bd9785, 0x7fac6dd0, 0x31cb8504, + 0x96eb27b3, 0x55fd3941, 0xda2547e6, 0xabca0a9a, 0x28507825, 0x530429f4, + 0x0a2c86da, 0xe9b66dfb, 0x68dc1462, 0xd7486900, 0x680ec0a4, 0x27a18dee, + 0x4f3ffea2, 0xe887ad8c, 0xb58ce006, 0x7af4d6b6, 0xaace1e7c, 0xd3375fec, + 0xce78a399, 0x406b2a42, 0x20fe9e35, 0xd9f385b9, 0xee39d7ab, 0x3b124e8b, + 0x1dc9faf7, 0x4b6d1856, 0x26a36631, 0xeae397b2, 0x3a6efa74, 0xdd5b4332, + 0x6841e7f7, 0xca7820fb, 0xfb0af54e, 0xd8feb397, 0x454056ac, 0xba489527, + 0x55533a3a, 0x20838d87, 0xfe6ba9b7, 0xd096954b, 0x55a867bc, 0xa1159a58, + 0xcca92963, 0x99e1db33, 0xa62a4a56, 0x3f3125f9, 0x5ef47e1c, 0x9029317c, + 0xfdf8e802, 0x04272f70, 0x80bb155c, 0x05282ce3, 0x95c11548, 0xe4c66d22, + 0x48c1133f, 0xc70f86dc, 0x07f9c9ee, 0x41041f0f, 0x404779a4, 0x5d886e17, + 0x325f51eb, 0xd59bc0d1, 0xf2bcc18f, 0x41113564, 0x257b7834, 0x602a9c60, + 0xdff8e8a3, 0x1f636c1b, 0x0e12b4c2, 0x02e1329e, 0xaf664fd1, 0xcad18115, + 0x6b2395e0, 0x333e92e1, 0x3b240b62, 0xeebeb922, 0x85b2a20e, 0xe6ba0d99, + 0xde720c8c, 0x2da2f728, 0xd0127845, 0x95b794fd, 0x647d0862, 0xe7ccf5f0, + 0x5449a36f, 0x877d48fa, 0xc39dfd27, 0xf33e8d1e, 0x0a476341, 0x992eff74, + 0x3a6f6eab, 0xf4f8fd37, 0xa812dc60, 0xa1ebddf8, 0x991be14c, 0xdb6e6b0d, + 0xc67b5510, 0x6d672c37, 0x2765d43b, 0xdcd0e804, 0xf1290dc7, 0xcc00ffa3, + 0xb5390f92, 0x690fed0b, 0x667b9ffb, 0xcedb7d9c, 0xa091cf0b, 0xd9155ea3, + 0xbb132f88, 0x515bad24, 0x7b9479bf, 0x763bd6eb, 0x37392eb3, 0xcc115979, + 0x8026e297, 0xf42e312d, 0x6842ada7, 0xc66a2b3b, 0x12754ccc, 0x782ef11c, + 0x6a124237, 0xb79251e7, 0x06a1bbe6, 0x4bfb6350, 0x1a6b1018, 0x11caedfa, + 0x3d25bdd8, 0xe2e1c3c9, 0x44421659, 0x0a121386, 0xd90cec6e, 0xd5abea2a, + 0x64af674e, 0xda86a85f, 0xbebfe988, 0x64e4c3fe, 0x9dbc8057, 0xf0f7c086, + 0x60787bf8, 0x6003604d, 0xd1fd8346, 0xf6381fb0, 0x7745ae04, 0xd736fccc, + 0x83426b33, 0xf01eab71, 0xb0804187, 0x3c005e5f, 0x77a057be, 0xbde8ae24, + 0x55464299, 0xbf582e61, 0x4e58f48f, 0xf2ddfda2, 0xf474ef38, 0x8789bdc2, + 0x5366f9c3, 0xc8b38e74, 0xb475f255, 0x46fcd9b9, 0x7aeb2661, 0x8b1ddf84, + 0x846a0e79, 0x915f95e2, 0x466e598e, 0x20b45770, 0x8cd55591, 0xc902de4c, + 0xb90bace1, 0xbb8205d0, 0x11a86248, 0x7574a99e, 0xb77f19b6, 0xe0a9dc09, + 0x662d09a1, 0xc4324633, 0xe85a1f02, 0x09f0be8c, 0x4a99a025, 0x1d6efe10, + 0x1ab93d1d, 0x0ba5a4df, 0xa186f20f, 0x2868f169, 0xdcb7da83, 0x573906fe, + 0xa1e2ce9b, 0x4fcd7f52, 0x50115e01, 0xa70683fa, 0xa002b5c4, 0x0de6d027, + 0x9af88c27, 0x773f8641, 0xc3604c06, 0x61a806b5, 0xf0177a28, 0xc0f586e0, + 0x006058aa, 0x30dc7d62, 0x11e69ed7, 0x2338ea63, 0x53c2dd94, 0xc2c21634, + 0xbbcbee56, 0x90bcb6de, 0xebfc7da1, 0xce591d76, 0x6f05e409, 0x4b7c0188, + 0x39720a3d, 0x7c927c24, 0x86e3725f, 0x724d9db9, 0x1ac15bb4, 0xd39eb8fc, + 0xed545578, 0x08fca5b5, 0xd83d7cd3, 0x4dad0fc4, 0x1e50ef5e, 0xb161e6f8, + 0xa28514d9, 0x6c51133c, 0x6fd5c7e7, 0x56e14ec4, 0x362abfce, 0xddc6c837, + 0xd79a3234, 0x92638212, 0x670efa8e, 0x406000e0]) + +iSbox3 :: Sbox +iSbox3 = array (0,255) (zip [0..255] + [0x3a39ce37, 0xd3faf5cf, 0xabc27737, 0x5ac52d1b, 0x5cb0679e, 0x4fa33742, + 0xd3822740, 0x99bc9bbe, 0xd5118e9d, 0xbf0f7315, 0xd62d1c7e, 0xc700c47b, + 0xb78c1b6b, 0x21a19045, 0xb26eb1be, 0x6a366eb4, 0x5748ab2f, 0xbc946e79, + 0xc6a376d2, 0x6549c2c8, 0x530ff8ee, 0x468dde7d, 0xd5730a1d, 0x4cd04dc6, + 0x2939bbdb, 0xa9ba4650, 0xac9526e8, 0xbe5ee304, 0xa1fad5f0, 0x6a2d519a, + 0x63ef8ce2, 0x9a86ee22, 0xc089c2b8, 0x43242ef6, 0xa51e03aa, 0x9cf2d0a4, + 0x83c061ba, 0x9be96a4d, 0x8fe51550, 0xba645bd6, 0x2826a2f9, 0xa73a3ae1, + 0x4ba99586, 0xef5562e9, 0xc72fefd3, 0xf752f7da, 0x3f046f69, 0x77fa0a59, + 0x80e4a915, 0x87b08601, 0x9b09e6ad, 0x3b3ee593, 0xe990fd5a, 0x9e34d797, + 0x2cf0b7d9, 0x022b8b51, 0x96d5ac3a, 0x017da67d, 0xd1cf3ed6, 0x7c7d2d28, + 0x1f9f25cf, 0xadf2b89b, 0x5ad6b472, 0x5a88f54c, 0xe029ac71, 0xe019a5e6, + 0x47b0acfd, 0xed93fa9b, 0xe8d3c48d, 0x283b57cc, 0xf8d56629, 0x79132e28, + 0x785f0191, 0xed756055, 0xf7960e44, 0xe3d35e8c, 0x15056dd4, 0x88f46dba, + 0x03a16125, 0x0564f0bd, 0xc3eb9e15, 0x3c9057a2, 0x97271aec, 0xa93a072a, + 0x1b3f6d9b, 0x1e6321f5, 0xf59c66fb, 0x26dcf319, 0x7533d928, 0xb155fdf5, + 0x03563482, 0x8aba3cbb, 0x28517711, 0xc20ad9f8, 0xabcc5167, 0xccad925f, + 0x4de81751, 0x3830dc8e, 0x379d5862, 0x9320f991, 0xea7a90c2, 0xfb3e7bce, + 0x5121ce64, 0x774fbe32, 0xa8b6e37e, 0xc3293d46, 0x48de5369, 0x6413e680, + 0xa2ae0810, 0xdd6db224, 0x69852dfd, 0x09072166, 0xb39a460a, 0x6445c0dd, + 0x586cdecf, 0x1c20c8ae, 0x5bbef7dd, 0x1b588d40, 0xccd2017f, 0x6bb4e3bb, + 0xdda26a7e, 0x3a59ff45, 0x3e350a44, 0xbcb4cdd5, 0x72eacea8, 0xfa6484bb, + 0x8d6612ae, 0xbf3c6f47, 0xd29be463, 0x542f5d9e, 0xaec2771b, 0xf64e6370, + 0x740e0d8d, 0xe75b1357, 0xf8721671, 0xaf537d5d, 0x4040cb08, 0x4eb4e2cc, + 0x34d2466a, 0x0115af84, 0xe1b00428, 0x95983a1d, 0x06b89fb4, 0xce6ea048, + 0x6f3f3b82, 0x3520ab82, 0x011a1d4b, 0x277227f8, 0x611560b1, 0xe7933fdc, + 0xbb3a792b, 0x344525bd, 0xa08839e1, 0x51ce794b, 0x2f32c9b7, 0xa01fbac9, + 0xe01cc87e, 0xbcc7d1f6, 0xcf0111c3, 0xa1e8aac7, 0x1a908749, 0xd44fbd9a, + 0xd0dadecb, 0xd50ada38, 0x0339c32a, 0xc6913667, 0x8df9317c, 0xe0b12b4f, + 0xf79e59b7, 0x43f5bb3a, 0xf2d519ff, 0x27d9459c, 0xbf97222c, 0x15e6fc2a, + 0x0f91fc71, 0x9b941525, 0xfae59361, 0xceb69ceb, 0xc2a86459, 0x12baa8d1, + 0xb6c1075e, 0xe3056a0c, 0x10d25065, 0xcb03a442, 0xe0ec6e0e, 0x1698db3b, + 0x4c98a0be, 0x3278e964, 0x9f1f9532, 0xe0d392df, 0xd3a0342b, 0x8971f21e, + 0x1b0a7441, 0x4ba3348c, 0xc5be7120, 0xc37632d8, 0xdf359f8d, 0x9b992f2e, + 0xe60b6f47, 0x0fe3f11d, 0xe54cda54, 0x1edad891, 0xce6279cf, 0xcd3e7e6f, + 0x1618b166, 0xfd2c1d05, 0x848fd2c5, 0xf6fb2299, 0xf523f357, 0xa6327623, + 0x93a83531, 0x56cccd02, 0xacf08162, 0x5a75ebb5, 0x6e163697, 0x88d273cc, + 0xde966292, 0x81b949d0, 0x4c50901b, 0x71c65614, 0xe6c6c7bd, 0x327a140a, + 0x45e1d006, 0xc3f27b9a, 0xc9aa53fd, 0x62a80f00, 0xbb25bfe2, 0x35bdd2f6, + 0x71126905, 0xb2040222, 0xb6cbcf7c, 0xcd769c2b, 0x53113ec0, 0x1640e3d3, + 0x38abbd60, 0x2547adf0, 0xba38209c, 0xf746ce76, 0x77afa1c5, 0x20756060, + 0x85cbfe4e, 0x8ae88dd8, 0x7aaaf9b0, 0x4cf9aa7e, 0x1948c25c, 0x02fb8a8c, + 0x01c36ae4, 0xd6ebe1f9, 0x90d4f869, 0xa65cdea0, 0x3f09252d, 0xc208e69f, + 0xb74e6132, 0xce77e25b, 0x578fdfe3, 0x3ac372e6]) ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -127,3 +127,4 @@ test('T21710a', [ unless(tables_next_to_code(), skip) , when(wordsize(32), skip) , only_ways(['optasm']) , grep_errmsg('(call)',[1]) ] , compile, ['-ddump-cmm -dno-typeable-binds']) +test('T23002', normal, compile, ['-fregs-graph']) ===================================== testsuite/tests/ffi/should_compile/T22774.hs ===================================== @@ -0,0 +1,4 @@ +module T22774 where + +foreign import javascript foo :: IO () + ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -44,3 +44,6 @@ test( ) test('T15531', normal, compile, ['-Wall']) test('T22043', [omit_ways(['ghci'])], compile, ['']) + +test('T22774', when(not js_arch(), expect_fail), compile, ['']) + ===================================== testsuite/tests/numeric/should_compile/T23019.hs ===================================== @@ -0,0 +1,21 @@ +module T23019 + ( + eexponent + ) where + +-- spine lazy, value strict list of doubles +data List + = Nil + | {-# UNPACK #-} !Double :! List + +infixr 5 :! + +newtype TowerDouble = Tower { getTower :: List } + +primal :: TowerDouble -> Double +primal (Tower (x:!_)) = x +primal _ = 0 + +eexponent :: TowerDouble -> Int +eexponent = exponent . primal + ===================================== testsuite/tests/numeric/should_compile/all.T ===================================== @@ -19,3 +19,4 @@ test('T20347', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-b test('T20448', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T19641', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T15547', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) +test('T23019', normal, compile, ['-O']) ===================================== testsuite/tests/simplCore/should_compile/T23026.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} + +module T23026 where + +import Data.Kind (Type) + +data Sing (a :: k) +data SingInstance (a :: k) = SingInstance (Sing a) + +app :: (Sing a -> SingInstance a) -> Sing a -> SingInstance a +app f x = f x +{-# NOINLINE app #-} + +withSomeSing + :: forall k2 k1 (f :: k2 -> k1 -> Type) a2 a1. + (Sing a2, Sing a1) + -> f a2 a1 + -> (forall b2 b1. f b2 b1 -> Int) + -> Int +withSomeSing (sa2, sa1) x g = + case app SingInstance sa2 of + SingInstance _ -> + case app SingInstance sa1 of + SingInstance _ -> g x +{-# INLINABLE withSomeSing #-} ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -476,3 +476,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) +test('T23026', normal, compile, ['-O']) ===================================== testsuite/tests/typecheck/should_fail/T22707.hs ===================================== @@ -0,0 +1,22 @@ +module T22707 where + +newtype Cont o i a = Cont {runCont ::(a -> i) -> o } + +t1:: Cont (i2 -> o) i1 a -> Cont o i2 (a -> i1) +t1 c = Cont $ \ati1tti2 -> (runCont c) (ati1tti2 $ \a -> evalCont (t1 c) >>== \ati1 -> return ati1 a ) + +evalCont:: Cont o a a -> o +evalCont c = (runCont c)id + +instance Monad (Cont p p) where + return a = Cont ($ a) + (>>=) = (>>==) + +class PMonad m where + (>>==):: m p q a -> (a -> m q r b) -> m p r b + +instance PMonad Cont where + (Cont cont) >>== afmb = Cont $ \bti -> cont $ \a -> (runCont . afmb) a bti + +main:: IO () +main = putStrLn "bug" ===================================== testsuite/tests/typecheck/should_fail/T22707.stderr ===================================== @@ -0,0 +1,16 @@ + +T22707.hs:6:37: error: [GHC-18872] + • Couldn't match kind ‘*’ with ‘GHC.Types.RuntimeRep’ + When matching types + p0 :: * + GHC.Types.LiftedRep :: GHC.Types.RuntimeRep + Expected: Cont o i1 a + Actual: Cont (i2 -> o) i1 a + • In the first argument of ‘runCont’, namely ‘c’ + In the expression: + (runCont c) + (ati1tti2 $ \ a -> evalCont (t1 c) >>== \ ati1 -> return ati1 a) + In the second argument of ‘($)’, namely + ‘\ ati1tti2 + -> (runCont c) + (ati1tti2 $ \ a -> evalCont (t1 c) >>== \ ati1 -> ...)’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -321,6 +321,7 @@ test('T7856', normal, compile_fail, ['']) test('T7869', normal, compile_fail, ['']) test('T7892', normal, compile_fail, ['']) test('T7809', normal, compile_fail, ['']) +test('T22707', normal, compile_fail, ['']) test('T7989', normal, compile_fail, ['']) test('T8034', normal, compile_fail, ['']) test('T8142', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3148604ebb3d6c21e6710943757b8b548292fe46...bc9615a4a4d45baca244604fed6236ee0b645aad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3148604ebb3d6c21e6710943757b8b548292fe46...bc9615a4a4d45baca244604fed6236ee0b645aad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 01:14:10 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 02 Mar 2023 20:14:10 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/hdoc-llvm-workaround2 Message-ID: <640149e234f6_3ab52bb2132c431607@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/hdoc-llvm-workaround2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hdoc-llvm-workaround2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 03:42:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Mar 2023 22:42:24 -0500 Subject: [Git][ghc/ghc][master] Don't suppress *all* Wanteds Message-ID: <64016ca0705d8_3ab52bd8fec303258a6@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 5 changed files: - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Types/Constraint.hs - + testsuite/tests/typecheck/should_fail/T22707.hs - + testsuite/tests/typecheck/should_fail/T22707.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -476,30 +476,37 @@ mkErrorItem ct , ei_m_reason = m_reason , ei_suppress = suppress }} +-- | Actually report this 'ErrorItem'. +unsuppressErrorItem :: ErrorItem -> ErrorItem +unsuppressErrorItem ei = ei { ei_suppress = False } + ---------------------------------------------------------------- reportWanteds :: SolverReportErrCtxt -> TcLevel -> WantedConstraints -> TcM () reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics , wc_errors = errs }) | isEmptyWC wc = traceTc "reportWanteds empty WC" empty | otherwise - = do { tidy_items <- mapMaybeM mkErrorItem tidy_cts + = do { tidy_items1 <- mapMaybeM mkErrorItem tidy_cts ; traceTc "reportWanteds 1" (vcat [ text "Simples =" <+> ppr simples , text "Suppress =" <+> ppr (cec_suppress ctxt) , text "tidy_cts =" <+> ppr tidy_cts - , text "tidy_items =" <+> ppr tidy_items + , text "tidy_items1 =" <+> ppr tidy_items1 , text "tidy_errs =" <+> ppr tidy_errs ]) - -- This check makes sure that we aren't suppressing the only error that will - -- actually stop compilation - ; assertPprM - ( do { errs_already <- ifErrsM (return True) (return False) - ; return $ - errs_already || -- we already reported an error (perhaps from an outer implication) - null simples || -- no errors to report here - any ignoreConstraint simples || -- one error is ignorable (is reported elsewhere) - not (all ei_suppress tidy_items) -- not all errors are suppressed - } ) - (vcat [text "reportWanteds is suppressing all errors"]) + -- Catch an awkward case in which /all/ errors are suppressed: + -- see Wrinkle at end of Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint + -- Unless we are sure that an error will be reported some other way (details + -- in the defn of tidy_items) un-suppress the lot. This makes sure we don't forget to + -- report an error at all, which is catastrophic: GHC proceeds to desguar and optimise + -- the program, even though it is full of type errors (#22702, #22793) + ; errs_already <- ifErrsM (return True) (return False) + ; let tidy_items + | not errs_already -- Have not already reported an error (perhaps + -- from an outer implication); see #21405 + , not (any ignoreConstraint simples) -- No error is ignorable (is reported elsewhere) + , all ei_suppress tidy_items1 -- All errors are suppressed + = map unsuppressErrorItem tidy_items1 + | otherwise = tidy_items1 -- First, deal with any out-of-scope errors: ; let (out_of_scope, other_holes, not_conc_errs) = partition_errors tidy_errs ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -2127,10 +2127,10 @@ uses GHC.Tc.Utils.anyUnfilledCoercionHoles to look through any filled coercion holes. The idea is that we wish to report the "root cause" -- the error that rewrote all the others. -Worry: It seems possible that *all* unsolved wanteds are rewritten by other -unsolved wanteds, so that e.g. w1 has w2 in its rewriter set, and w2 has -w1 in its rewiter set. We are unable to come up with an example of this in -practice, however, and so we believe this case cannot happen. +Wrinkle: In #22707, we have a case where all of the Wanteds have rewritten +each other. In order to report /some/ error in this case, we simply report +all the Wanteds. The user will get a perhaps-confusing error message, but +they've written a confusing program! Note [Avoiding rewriting cycles] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/typecheck/should_fail/T22707.hs ===================================== @@ -0,0 +1,22 @@ +module T22707 where + +newtype Cont o i a = Cont {runCont ::(a -> i) -> o } + +t1:: Cont (i2 -> o) i1 a -> Cont o i2 (a -> i1) +t1 c = Cont $ \ati1tti2 -> (runCont c) (ati1tti2 $ \a -> evalCont (t1 c) >>== \ati1 -> return ati1 a ) + +evalCont:: Cont o a a -> o +evalCont c = (runCont c)id + +instance Monad (Cont p p) where + return a = Cont ($ a) + (>>=) = (>>==) + +class PMonad m where + (>>==):: m p q a -> (a -> m q r b) -> m p r b + +instance PMonad Cont where + (Cont cont) >>== afmb = Cont $ \bti -> cont $ \a -> (runCont . afmb) a bti + +main:: IO () +main = putStrLn "bug" ===================================== testsuite/tests/typecheck/should_fail/T22707.stderr ===================================== @@ -0,0 +1,16 @@ + +T22707.hs:6:37: error: [GHC-18872] + • Couldn't match kind ‘*’ with ‘GHC.Types.RuntimeRep’ + When matching types + p0 :: * + GHC.Types.LiftedRep :: GHC.Types.RuntimeRep + Expected: Cont o i1 a + Actual: Cont (i2 -> o) i1 a + • In the first argument of ‘runCont’, namely ‘c’ + In the expression: + (runCont c) + (ati1tti2 $ \ a -> evalCont (t1 c) >>== \ ati1 -> return ati1 a) + In the second argument of ‘($)’, namely + ‘\ ati1tti2 + -> (runCont c) + (ati1tti2 $ \ a -> evalCont (t1 c) >>== \ ati1 -> ...)’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -321,6 +321,7 @@ test('T7856', normal, compile_fail, ['']) test('T7869', normal, compile_fail, ['']) test('T7892', normal, compile_fail, ['']) test('T7809', normal, compile_fail, ['']) +test('T22707', normal, compile_fail, ['']) test('T7989', normal, compile_fail, ['']) test('T8034', normal, compile_fail, ['']) test('T8142', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ed573a53ee454db240b9fb1a17e28c97b6eb53a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ed573a53ee454db240b9fb1a17e28c97b6eb53a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 03:43:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Mar 2023 22:43:04 -0500 Subject: [Git][ghc/ghc][master] Check for platform support for JavaScript foreign imports Message-ID: <64016cc837fbc_3ab52bd8fec1c331191@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - 3 changed files: - compiler/GHC/Tc/Gen/Foreign.hs - + testsuite/tests/ffi/should_compile/T22774.hs - testsuite/tests/ffi/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -341,9 +341,10 @@ tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) (L ls safety) mh checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty return (CImport src (L lc cconv) (L ls safety) mh (CFunction target)) | cconv == JavaScriptCallConv = do + cconv' <- checkCConv (Right idecl) cconv checkCg (Right idecl) backendValidityOfCImport -- leave the rest to the JS backend (at least for now) - return (CImport src (L lc cconv) (L ls safety) mh (CFunction target)) + return (CImport src (L lc cconv') (L ls safety) mh (CFunction target)) | otherwise = do -- Normal foreign import checkCg (Right idecl) backendValidityOfCImport cconv' <- checkCConv (Right idecl) cconv ===================================== testsuite/tests/ffi/should_compile/T22774.hs ===================================== @@ -0,0 +1,4 @@ +module T22774 where + +foreign import javascript foo :: IO () + ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -44,3 +44,6 @@ test( ) test('T15531', normal, compile, ['-Wall']) test('T22043', [omit_ways(['ghci'])], compile, ['']) + +test('T22774', when(not js_arch(), expect_fail), compile, ['']) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8919f34102cae1ff3bae95b7f53e5d93dbad7ecf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8919f34102cae1ff3bae95b7f53e5d93dbad7ecf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 03:43:44 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Mar 2023 22:43:44 -0500 Subject: [Git][ghc/ghc][master] 4 commits: rts: Statically assert alignment of Capability Message-ID: <64016cf054174_3ab52bda7ec40338992@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - 4 changed files: - rts/Capability.c - rts/Capability.h - rts/RtsUtils.c - rts/RtsUtils.h Changes: ===================================== rts/Capability.c ===================================== @@ -438,8 +438,9 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS) { for (uint32_t i = 0; i < to; i++) { if (i >= from) { - capabilities[i] = stgMallocBytes(sizeof(Capability), - "moreCapabilities"); + capabilities[i] = stgMallocAlignedBytes(sizeof(Capability), + CAPABILITY_ALIGNMENT, + "moreCapabilities"); initCapability(capabilities[i], i); } } @@ -1274,7 +1275,7 @@ freeCapabilities (void) Capability *cap = getCapability(i); freeCapability(cap); if (cap != &MainCapability) { - stgFree(cap); + stgFreeAligned(cap); } } #else ===================================== rts/Capability.h ===================================== @@ -28,6 +28,14 @@ #include "BeginPrivate.h" +// We never want a Capability to overlap a cache line with +// anything else, so round it up to a cache line size: +#if defined(s390x_HOST_ARCH) +#define CAPABILITY_ALIGNMENT 256 +#else +#define CAPABILITY_ALIGNMENT 64 +#endif + /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */ struct Capability_ { // State required by the STG virtual machine when running Haskell @@ -169,14 +177,12 @@ struct Capability_ { StgTRecHeader *free_trec_headers; uint32_t transaction_tokens; } // typedef Capability is defined in RtsAPI.h - // We never want a Capability to overlap a cache line with anything - // else, so round it up to a cache line size: -#if defined(s390x_HOST_ARCH) - ATTRIBUTE_ALIGNED(256) -#elif !defined(mingw32_HOST_OS) - ATTRIBUTE_ALIGNED(64) -#endif - ; + ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT) +; + +// We allocate arrays of Capabilities therefore we must ensure that the size is +// a multiple of the claimed alignment +GHC_STATIC_ASSERT(sizeof(struct Capability_) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size"); #if defined(THREADED_RTS) #define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId()) ===================================== rts/RtsUtils.c ===================================== @@ -57,9 +57,9 @@ extern char *ctime_r(const time_t *, char *); void * stgMallocBytes (size_t n, char *msg) { - void *space; + void *space = malloc(n); - if ((space = malloc(n)) == NULL) { + if (space == NULL) { /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): * * "Upon successful completion with size not equal to 0, malloc() shall @@ -128,6 +128,53 @@ stgFree(void* p) free(p); } +// N.B. Allocations resulting from this function must be freed by +// `stgFreeAligned`, not `stgFree`. This is necessary due to the properties of Windows' `_aligned_malloc` +void * +stgMallocAlignedBytes (size_t n, size_t align, char *msg) +{ + void *space; + +#if defined(mingw32_HOST_OS) + space = _aligned_malloc(n, align); +#else + if (posix_memalign(&space, align, n)) { + space = NULL; // Allocation failed + } +#endif + + if (space == NULL) { + /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): + * + * "Upon successful completion with size not equal to 0, malloc() shall + * return a pointer to the allocated space. If size is 0, either a null + * pointer or a unique pointer that can be successfully passed to free() + * shall be returned. Otherwise, it shall return a null pointer and set + * errno to indicate the error." + * + * Consequently, a NULL pointer being returned by `malloc()` for a 0-size + * allocation is *not* to be considered an error. + */ + if (n == 0) return NULL; + + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + rtsConfig.mallocFailHook((W_) n, msg); + stg_exit(EXIT_INTERNAL_ERROR); + } + IF_DEBUG(zero_on_gc, memset(space, 0xbb, n)); + return space; +} + +void +stgFreeAligned (void *p) +{ +#if defined(mingw32_HOST_OS) + _aligned_free(p); +#else + free(p); +#endif +} + /* ----------------------------------------------------------------------------- Stack/heap overflow -------------------------------------------------------------------------- */ ===================================== rts/RtsUtils.h ===================================== @@ -29,16 +29,9 @@ void *stgMallocBytes(size_t n, char *msg) * See: https://gitlab.haskell.org/ghc/ghc/-/issues/22380 */ -void *stgReallocBytes(void *p, size_t n, char *msg) - STG_MALLOC1(stgFree) - STG_ALLOC_SIZE1(2) - STG_RETURNS_NONNULL; -/* Note: `stgRallocBytes` can *not* be tagged as `STG_MALLOC` - * since its return value *can* alias an existing pointer (i.e., - * the given pointer `p`). - * See the documentation of the `malloc` attribute in the GCC manual - * for more information. - */ +void *stgMallocAlignedBytes(size_t n, size_t align, char *msg); + +void *stgReallocBytes(void *p, size_t n, char *msg); void *stgCallocBytes(size_t count, size_t size, char *msg) STG_MALLOC STG_MALLOC1(stgFree) @@ -48,6 +41,10 @@ void *stgCallocBytes(size_t count, size_t size, char *msg) char *stgStrndup(const char *s, size_t n) STG_MALLOC STG_MALLOC1(stgFree); +void *stgMallocAlignedBytes(size_t n, size_t align, char *msg); + +void stgFreeAligned(void *p); + /* ----------------------------------------------------------------------------- * Misc other utilities * -------------------------------------------------------------------------- */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8919f34102cae1ff3bae95b7f53e5d93dbad7ecf...5464c73f192f76e75160e8992fe9720d943ae611 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8919f34102cae1ff3bae95b7f53e5d93dbad7ecf...5464c73f192f76e75160e8992fe9720d943ae611 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 03:44:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Mar 2023 22:44:22 -0500 Subject: [Git][ghc/ghc][master] constant folding: Correct type of decodeDouble_Int64 rule Message-ID: <64016d16dd993_3ab52bdc438dc34459e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 3 changed files: - compiler/GHC/Core/Opt/ConstantFold.hs - + testsuite/tests/numeric/should_compile/T23019.hs - testsuite/tests/numeric/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -1110,14 +1110,10 @@ doubleOp2 _ _ _ _ = Nothing -------------------------- doubleDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr doubleDecodeOp env (LitDouble ((decodeFloat . fromRational @Double) -> (m, e))) - = Just $ mkCoreUnboxedTuple [ Lit (mkLitINT64 (toInteger m)) + = Just $ mkCoreUnboxedTuple [ Lit (mkLitInt64Wrap (toInteger m)) , mkIntVal platform (toInteger e) ] where platform = roPlatform env - mkLitINT64 | platformWordSizeInBits platform < 64 - = mkLitInt64Wrap - | otherwise - = mkLitIntWrap platform doubleDecodeOp _ _ = Nothing ===================================== testsuite/tests/numeric/should_compile/T23019.hs ===================================== @@ -0,0 +1,21 @@ +module T23019 + ( + eexponent + ) where + +-- spine lazy, value strict list of doubles +data List + = Nil + | {-# UNPACK #-} !Double :! List + +infixr 5 :! + +newtype TowerDouble = Tower { getTower :: List } + +primal :: TowerDouble -> Double +primal (Tower (x:!_)) = x +primal _ = 0 + +eexponent :: TowerDouble -> Int +eexponent = exponent . primal + ===================================== testsuite/tests/numeric/should_compile/all.T ===================================== @@ -19,3 +19,4 @@ test('T20347', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-b test('T20448', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T19641', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T15547', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) +test('T23019', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a86aae8b562c12bb3cee8dcae5156b647f1a74ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a86aae8b562c12bb3cee8dcae5156b647f1a74ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 03:44:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Mar 2023 22:44:56 -0500 Subject: [Git][ghc/ghc][master] ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Message-ID: <64016d38bb9f2_3ab52bddfc930349836@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 3 changed files: - compiler/GHC/CmmToAsm/AArch64/Instr.hs - + testsuite/tests/codeGen/should_compile/T23002.hs - testsuite/tests/codeGen/should_compile/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -73,6 +73,7 @@ regUsageOfInstr :: Platform -> Instr -> RegUsage regUsageOfInstr platform instr = case instr of ANN _ i -> regUsageOfInstr platform i COMMENT{} -> usage ([], []) + MULTILINE_COMMENT{} -> usage ([], []) PUSH_STACK_FRAME -> usage ([], []) POP_STACK_FRAME -> usage ([], []) DELTA{} -> usage ([], []) @@ -207,11 +208,12 @@ callerSavedRegisters patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr patchRegsOfInstr instr env = case instr of -- 0. Meta Instructions - ANN d i -> ANN d (patchRegsOfInstr i env) - COMMENT{} -> instr - PUSH_STACK_FRAME -> instr - POP_STACK_FRAME -> instr - DELTA{} -> instr + ANN d i -> ANN d (patchRegsOfInstr i env) + COMMENT{} -> instr + MULTILINE_COMMENT{} -> instr + PUSH_STACK_FRAME -> instr + POP_STACK_FRAME -> instr + DELTA{} -> instr -- 1. Arithmetic Instructions ---------------------------------------------- ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) ===================================== testsuite/tests/codeGen/should_compile/T23002.hs ===================================== @@ -0,0 +1,257 @@ +module T23002 + (bfMakeKey, + bfEnc, + bfDec) where + +import Data.Array +import Data.Bits +import Data.Word +import Data.Char + +type Pbox = Array Word32 Word32 +type Sbox = Array Word32 Word32 + +data BF = BF Pbox Sbox Sbox Sbox Sbox + +bfEnc :: BF -> [Word32] -> [Word32] +bfEnc a b = aux a b 0 + where + aux :: BF -> [Word32] -> Word32 -> [Word32] + aux bs@(BF p s0 s1 s2 s3) (l:r:[]) 16 = (r `xor` p!17):(l `xor` p!16):[] + aux bs@(BF p s0 s1 s2 s3) (l:r:[]) i = aux bs (newr:newl:[]) (i+1) + where newl = l `xor` (p ! i) + newr = r `xor` (f newl) + f :: Word32 -> Word32 + f t = ((s0!a + s1!b) `xor` (s2 ! c)) + (s3 ! d) + where a = (t `shiftR` 24) + b = ((t `shiftL` 8) `shiftR` 24) + c = ((t `shiftL` 16) `shiftR` 24) + d = ((t `shiftL` 24) `shiftR` 24) + + +bfDec :: BF -> [Word32] -> [Word32] +bfDec (BF p s0 s1 s2 s3) a = bfEnc (BF (revP p) s0 s1 s2 s3) a + where revP :: Pbox -> Pbox + revP x = x//[(i, x ! (17-i)) | i <- [0..17]] + +bfMakeKey :: [Char] -> BF +bfMakeKey [] = procKey [0,0] (BF iPbox iSbox0 iSbox1 iSbox2 iSbox3) 0 +bfMakeKey k = procKey [0,0] (BF (string2Pbox k) iSbox0 iSbox1 iSbox2 iSbox3) 0 + +string2Pbox :: [Char] -> Pbox +string2Pbox k = array (0,17) [(fromIntegral i,xtext!!i) | i <- [0..17]] + where xtext = zipWith (xor) + (compress4 (doShift (makeTo72 (charsToWord32s k) 0) 0)) + [iPbox ! (fromIntegral i) | i <- [0..17]] + charsToWord32s [] = [] + charsToWord32s (k:ks) = (fromIntegral $ fromEnum k) : charsToWord32s ks + makeTo72 k 72 = [] + makeTo72 k i = k!!(i `mod` (length k)) : makeTo72 k (i+1) + doShift [] i = [] + doShift (w:ws) i = w `shiftL` (8*(3 - (i `mod` 4))) : doShift ws (i+1) + compress4 [] = [] + compress4 (a:b:c:d:etc) = (a .|. b .|. c .|. d) : compress4 etc + +procKey :: [Word32] -> BF -> Word32 -> BF +procKey (l:r:[]) tpbf@(BF p s0 s1 s2 s3) 1042 = tpbf +procKey (l:r:[]) tpbf@(BF p s0 s1 s2 s3) i = procKey [nl,nr] (newbf i) (i+2) + where [nl,nr] = bfEnc tpbf [l,r] + newbf x | x < 18 = (BF (p//[(x,nl),(x+1,nr)]) s0 s1 s2 s3) + | x < 274 = (BF p (s0//[(x-18,nl),(x-17,nr)]) s1 s2 s3) + | x < 530 = (BF p s0 (s1//[(x-274,nl),(x-273,nr)]) s2 s3) + | x < 786 = (BF p s0 s1 (s2//[(x-530,nl),(x-529,nr)]) s3) + | x < 1042 = (BF p s0 s1 s2 (s3//[(x-786,nl),(x-785,nr)])) + + + +---------- INITIAL S AND P BOXES ARE THE HEXADECIMAL DIGITS OF PI ------------ + +iPbox :: Pbox +iPbox = array (0,17) (zip [0..17] + [0x243f6a88, 0x85a308d3, 0x13198a2e, 0x03707344, 0xa4093822, 0x299f31d0, + 0x082efa98, 0xec4e6c89, 0x452821e6, 0x38d01377, 0xbe5466cf, 0x34e90c6c, + 0xc0ac29b7, 0xc97c50dd, 0x3f84d5b5, 0xb5470917, 0x9216d5d9, 0x8979fb1b]) + +iSbox0 :: Sbox +iSbox0 = array (0,255) (zip [0..255] + [0xd1310ba6, 0x98dfb5ac, 0x2ffd72db, 0xd01adfb7, 0xb8e1afed, 0x6a267e96, + 0xba7c9045, 0xf12c7f99, 0x24a19947, 0xb3916cf7, 0x0801f2e2, 0x858efc16, + 0x636920d8, 0x71574e69, 0xa458fea3, 0xf4933d7e, 0x0d95748f, 0x728eb658, + 0x718bcd58, 0x82154aee, 0x7b54a41d, 0xc25a59b5, 0x9c30d539, 0x2af26013, + 0xc5d1b023, 0x286085f0, 0xca417918, 0xb8db38ef, 0x8e79dcb0, 0x603a180e, + 0x6c9e0e8b, 0xb01e8a3e, 0xd71577c1, 0xbd314b27, 0x78af2fda, 0x55605c60, + 0xe65525f3, 0xaa55ab94, 0x57489862, 0x63e81440, 0x55ca396a, 0x2aab10b6, + 0xb4cc5c34, 0x1141e8ce, 0xa15486af, 0x7c72e993, 0xb3ee1411, 0x636fbc2a, + 0x2ba9c55d, 0x741831f6, 0xce5c3e16, 0x9b87931e, 0xafd6ba33, 0x6c24cf5c, + 0x7a325381, 0x28958677, 0x3b8f4898, 0x6b4bb9af, 0xc4bfe81b, 0x66282193, + 0x61d809cc, 0xfb21a991, 0x487cac60, 0x5dec8032, 0xef845d5d, 0xe98575b1, + 0xdc262302, 0xeb651b88, 0x23893e81, 0xd396acc5, 0x0f6d6ff3, 0x83f44239, + 0x2e0b4482, 0xa4842004, 0x69c8f04a, 0x9e1f9b5e, 0x21c66842, 0xf6e96c9a, + 0x670c9c61, 0xabd388f0, 0x6a51a0d2, 0xd8542f68, 0x960fa728, 0xab5133a3, + 0x6eef0b6c, 0x137a3be4, 0xba3bf050, 0x7efb2a98, 0xa1f1651d, 0x39af0176, + 0x66ca593e, 0x82430e88, 0x8cee8619, 0x456f9fb4, 0x7d84a5c3, 0x3b8b5ebe, + 0xe06f75d8, 0x85c12073, 0x401a449f, 0x56c16aa6, 0x4ed3aa62, 0x363f7706, + 0x1bfedf72, 0x429b023d, 0x37d0d724, 0xd00a1248, 0xdb0fead3, 0x49f1c09b, + 0x075372c9, 0x80991b7b, 0x25d479d8, 0xf6e8def7, 0xe3fe501a, 0xb6794c3b, + 0x976ce0bd, 0x04c006ba, 0xc1a94fb6, 0x409f60c4, 0x5e5c9ec2, 0x196a2463, + 0x68fb6faf, 0x3e6c53b5, 0x1339b2eb, 0x3b52ec6f, 0x6dfc511f, 0x9b30952c, + 0xcc814544, 0xaf5ebd09, 0xbee3d004, 0xde334afd, 0x660f2807, 0x192e4bb3, + 0xc0cba857, 0x45c8740f, 0xd20b5f39, 0xb9d3fbdb, 0x5579c0bd, 0x1a60320a, + 0xd6a100c6, 0x402c7279, 0x679f25fe, 0xfb1fa3cc, 0x8ea5e9f8, 0xdb3222f8, + 0x3c7516df, 0xfd616b15, 0x2f501ec8, 0xad0552ab, 0x323db5fa, 0xfd238760, + 0x53317b48, 0x3e00df82, 0x9e5c57bb, 0xca6f8ca0, 0x1a87562e, 0xdf1769db, + 0xd542a8f6, 0x287effc3, 0xac6732c6, 0x8c4f5573, 0x695b27b0, 0xbbca58c8, + 0xe1ffa35d, 0xb8f011a0, 0x10fa3d98, 0xfd2183b8, 0x4afcb56c, 0x2dd1d35b, + 0x9a53e479, 0xb6f84565, 0xd28e49bc, 0x4bfb9790, 0xe1ddf2da, 0xa4cb7e33, + 0x62fb1341, 0xcee4c6e8, 0xef20cada, 0x36774c01, 0xd07e9efe, 0x2bf11fb4, + 0x95dbda4d, 0xae909198, 0xeaad8e71, 0x6b93d5a0, 0xd08ed1d0, 0xafc725e0, + 0x8e3c5b2f, 0x8e7594b7, 0x8ff6e2fb, 0xf2122b64, 0x8888b812, 0x900df01c, + 0x4fad5ea0, 0x688fc31c, 0xd1cff191, 0xb3a8c1ad, 0x2f2f2218, 0xbe0e1777, + 0xea752dfe, 0x8b021fa1, 0xe5a0cc0f, 0xb56f74e8, 0x18acf3d6, 0xce89e299, + 0xb4a84fe0, 0xfd13e0b7, 0x7cc43b81, 0xd2ada8d9, 0x165fa266, 0x80957705, + 0x93cc7314, 0x211a1477, 0xe6ad2065, 0x77b5fa86, 0xc75442f5, 0xfb9d35cf, + 0xebcdaf0c, 0x7b3e89a0, 0xd6411bd3, 0xae1e7e49, 0x00250e2d, 0x2071b35e, + 0x226800bb, 0x57b8e0af, 0x2464369b, 0xf009b91e, 0x5563911d, 0x59dfa6aa, + 0x78c14389, 0xd95a537f, 0x207d5ba2, 0x02e5b9c5, 0x83260376, 0x6295cfa9, + 0x11c81968, 0x4e734a41, 0xb3472dca, 0x7b14a94a, 0x1b510052, 0x9a532915, + 0xd60f573f, 0xbc9bc6e4, 0x2b60a476, 0x81e67400, 0x08ba6fb5, 0x571be91f, + 0xf296ec6b, 0x2a0dd915, 0xb6636521, 0xe7b9f9b6, 0xff34052e, 0xc5855664, + 0x53b02d5d, 0xa99f8fa1, 0x08ba4799, 0x6e85076a]) + +iSbox1 :: Sbox +iSbox1 = array (0,255) (zip [0..255] + [0x4b7a70e9, 0xb5b32944, 0xdb75092e, 0xc4192623, 0xad6ea6b0, 0x49a7df7d, + 0x9cee60b8, 0x8fedb266, 0xecaa8c71, 0x699a17ff, 0x5664526c, 0xc2b19ee1, + 0x193602a5, 0x75094c29, 0xa0591340, 0xe4183a3e, 0x3f54989a, 0x5b429d65, + 0x6b8fe4d6, 0x99f73fd6, 0xa1d29c07, 0xefe830f5, 0x4d2d38e6, 0xf0255dc1, + 0x4cdd2086, 0x8470eb26, 0x6382e9c6, 0x021ecc5e, 0x09686b3f, 0x3ebaefc9, + 0x3c971814, 0x6b6a70a1, 0x687f3584, 0x52a0e286, 0xb79c5305, 0xaa500737, + 0x3e07841c, 0x7fdeae5c, 0x8e7d44ec, 0x5716f2b8, 0xb03ada37, 0xf0500c0d, + 0xf01c1f04, 0x0200b3ff, 0xae0cf51a, 0x3cb574b2, 0x25837a58, 0xdc0921bd, + 0xd19113f9, 0x7ca92ff6, 0x94324773, 0x22f54701, 0x3ae5e581, 0x37c2dadc, + 0xc8b57634, 0x9af3dda7, 0xa9446146, 0x0fd0030e, 0xecc8c73e, 0xa4751e41, + 0xe238cd99, 0x3bea0e2f, 0x3280bba1, 0x183eb331, 0x4e548b38, 0x4f6db908, + 0x6f420d03, 0xf60a04bf, 0x2cb81290, 0x24977c79, 0x5679b072, 0xbcaf89af, + 0xde9a771f, 0xd9930810, 0xb38bae12, 0xdccf3f2e, 0x5512721f, 0x2e6b7124, + 0x501adde6, 0x9f84cd87, 0x7a584718, 0x7408da17, 0xbc9f9abc, 0xe94b7d8c, + 0xec7aec3a, 0xdb851dfa, 0x63094366, 0xc464c3d2, 0xef1c1847, 0x3215d908, + 0xdd433b37, 0x24c2ba16, 0x12a14d43, 0x2a65c451, 0x50940002, 0x133ae4dd, + 0x71dff89e, 0x10314e55, 0x81ac77d6, 0x5f11199b, 0x043556f1, 0xd7a3c76b, + 0x3c11183b, 0x5924a509, 0xf28fe6ed, 0x97f1fbfa, 0x9ebabf2c, 0x1e153c6e, + 0x86e34570, 0xeae96fb1, 0x860e5e0a, 0x5a3e2ab3, 0x771fe71c, 0x4e3d06fa, + 0x2965dcb9, 0x99e71d0f, 0x803e89d6, 0x5266c825, 0x2e4cc978, 0x9c10b36a, + 0xc6150eba, 0x94e2ea78, 0xa5fc3c53, 0x1e0a2df4, 0xf2f74ea7, 0x361d2b3d, + 0x1939260f, 0x19c27960, 0x5223a708, 0xf71312b6, 0xebadfe6e, 0xeac31f66, + 0xe3bc4595, 0xa67bc883, 0xb17f37d1, 0x018cff28, 0xc332ddef, 0xbe6c5aa5, + 0x65582185, 0x68ab9802, 0xeecea50f, 0xdb2f953b, 0x2aef7dad, 0x5b6e2f84, + 0x1521b628, 0x29076170, 0xecdd4775, 0x619f1510, 0x13cca830, 0xeb61bd96, + 0x0334fe1e, 0xaa0363cf, 0xb5735c90, 0x4c70a239, 0xd59e9e0b, 0xcbaade14, + 0xeecc86bc, 0x60622ca7, 0x9cab5cab, 0xb2f3846e, 0x648b1eaf, 0x19bdf0ca, + 0xa02369b9, 0x655abb50, 0x40685a32, 0x3c2ab4b3, 0x319ee9d5, 0xc021b8f7, + 0x9b540b19, 0x875fa099, 0x95f7997e, 0x623d7da8, 0xf837889a, 0x97e32d77, + 0x11ed935f, 0x16681281, 0x0e358829, 0xc7e61fd6, 0x96dedfa1, 0x7858ba99, + 0x57f584a5, 0x1b227263, 0x9b83c3ff, 0x1ac24696, 0xcdb30aeb, 0x532e3054, + 0x8fd948e4, 0x6dbc3128, 0x58ebf2ef, 0x34c6ffea, 0xfe28ed61, 0xee7c3c73, + 0x5d4a14d9, 0xe864b7e3, 0x42105d14, 0x203e13e0, 0x45eee2b6, 0xa3aaabea, + 0xdb6c4f15, 0xfacb4fd0, 0xc742f442, 0xef6abbb5, 0x654f3b1d, 0x41cd2105, + 0xd81e799e, 0x86854dc7, 0xe44b476a, 0x3d816250, 0xcf62a1f2, 0x5b8d2646, + 0xfc8883a0, 0xc1c7b6a3, 0x7f1524c3, 0x69cb7492, 0x47848a0b, 0x5692b285, + 0x095bbf00, 0xad19489d, 0x1462b174, 0x23820e00, 0x58428d2a, 0x0c55f5ea, + 0x1dadf43e, 0x233f7061, 0x3372f092, 0x8d937e41, 0xd65fecf1, 0x6c223bdb, + 0x7cde3759, 0xcbee7460, 0x4085f2a7, 0xce77326e, 0xa6078084, 0x19f8509e, + 0xe8efd855, 0x61d99735, 0xa969a7aa, 0xc50c06c2, 0x5a04abfc, 0x800bcadc, + 0x9e447a2e, 0xc3453484, 0xfdd56705, 0x0e1e9ec9, 0xdb73dbd3, 0x105588cd, + 0x675fda79, 0xe3674340, 0xc5c43465, 0x713e38d8, 0x3d28f89e, 0xf16dff20, + 0x153e21e7, 0x8fb03d4a, 0xe6e39f2b, 0xdb83adf7]) + +iSbox2 :: Sbox +iSbox2 = array (0,255) (zip [0..255] + [0xe93d5a68, 0x948140f7, 0xf64c261c, 0x94692934, 0x411520f7, 0x7602d4f7, + 0xbcf46b2e, 0xd4a20068, 0xd4082471, 0x3320f46a, 0x43b7d4b7, 0x500061af, + 0x1e39f62e, 0x97244546, 0x14214f74, 0xbf8b8840, 0x4d95fc1d, 0x96b591af, + 0x70f4ddd3, 0x66a02f45, 0xbfbc09ec, 0x03bd9785, 0x7fac6dd0, 0x31cb8504, + 0x96eb27b3, 0x55fd3941, 0xda2547e6, 0xabca0a9a, 0x28507825, 0x530429f4, + 0x0a2c86da, 0xe9b66dfb, 0x68dc1462, 0xd7486900, 0x680ec0a4, 0x27a18dee, + 0x4f3ffea2, 0xe887ad8c, 0xb58ce006, 0x7af4d6b6, 0xaace1e7c, 0xd3375fec, + 0xce78a399, 0x406b2a42, 0x20fe9e35, 0xd9f385b9, 0xee39d7ab, 0x3b124e8b, + 0x1dc9faf7, 0x4b6d1856, 0x26a36631, 0xeae397b2, 0x3a6efa74, 0xdd5b4332, + 0x6841e7f7, 0xca7820fb, 0xfb0af54e, 0xd8feb397, 0x454056ac, 0xba489527, + 0x55533a3a, 0x20838d87, 0xfe6ba9b7, 0xd096954b, 0x55a867bc, 0xa1159a58, + 0xcca92963, 0x99e1db33, 0xa62a4a56, 0x3f3125f9, 0x5ef47e1c, 0x9029317c, + 0xfdf8e802, 0x04272f70, 0x80bb155c, 0x05282ce3, 0x95c11548, 0xe4c66d22, + 0x48c1133f, 0xc70f86dc, 0x07f9c9ee, 0x41041f0f, 0x404779a4, 0x5d886e17, + 0x325f51eb, 0xd59bc0d1, 0xf2bcc18f, 0x41113564, 0x257b7834, 0x602a9c60, + 0xdff8e8a3, 0x1f636c1b, 0x0e12b4c2, 0x02e1329e, 0xaf664fd1, 0xcad18115, + 0x6b2395e0, 0x333e92e1, 0x3b240b62, 0xeebeb922, 0x85b2a20e, 0xe6ba0d99, + 0xde720c8c, 0x2da2f728, 0xd0127845, 0x95b794fd, 0x647d0862, 0xe7ccf5f0, + 0x5449a36f, 0x877d48fa, 0xc39dfd27, 0xf33e8d1e, 0x0a476341, 0x992eff74, + 0x3a6f6eab, 0xf4f8fd37, 0xa812dc60, 0xa1ebddf8, 0x991be14c, 0xdb6e6b0d, + 0xc67b5510, 0x6d672c37, 0x2765d43b, 0xdcd0e804, 0xf1290dc7, 0xcc00ffa3, + 0xb5390f92, 0x690fed0b, 0x667b9ffb, 0xcedb7d9c, 0xa091cf0b, 0xd9155ea3, + 0xbb132f88, 0x515bad24, 0x7b9479bf, 0x763bd6eb, 0x37392eb3, 0xcc115979, + 0x8026e297, 0xf42e312d, 0x6842ada7, 0xc66a2b3b, 0x12754ccc, 0x782ef11c, + 0x6a124237, 0xb79251e7, 0x06a1bbe6, 0x4bfb6350, 0x1a6b1018, 0x11caedfa, + 0x3d25bdd8, 0xe2e1c3c9, 0x44421659, 0x0a121386, 0xd90cec6e, 0xd5abea2a, + 0x64af674e, 0xda86a85f, 0xbebfe988, 0x64e4c3fe, 0x9dbc8057, 0xf0f7c086, + 0x60787bf8, 0x6003604d, 0xd1fd8346, 0xf6381fb0, 0x7745ae04, 0xd736fccc, + 0x83426b33, 0xf01eab71, 0xb0804187, 0x3c005e5f, 0x77a057be, 0xbde8ae24, + 0x55464299, 0xbf582e61, 0x4e58f48f, 0xf2ddfda2, 0xf474ef38, 0x8789bdc2, + 0x5366f9c3, 0xc8b38e74, 0xb475f255, 0x46fcd9b9, 0x7aeb2661, 0x8b1ddf84, + 0x846a0e79, 0x915f95e2, 0x466e598e, 0x20b45770, 0x8cd55591, 0xc902de4c, + 0xb90bace1, 0xbb8205d0, 0x11a86248, 0x7574a99e, 0xb77f19b6, 0xe0a9dc09, + 0x662d09a1, 0xc4324633, 0xe85a1f02, 0x09f0be8c, 0x4a99a025, 0x1d6efe10, + 0x1ab93d1d, 0x0ba5a4df, 0xa186f20f, 0x2868f169, 0xdcb7da83, 0x573906fe, + 0xa1e2ce9b, 0x4fcd7f52, 0x50115e01, 0xa70683fa, 0xa002b5c4, 0x0de6d027, + 0x9af88c27, 0x773f8641, 0xc3604c06, 0x61a806b5, 0xf0177a28, 0xc0f586e0, + 0x006058aa, 0x30dc7d62, 0x11e69ed7, 0x2338ea63, 0x53c2dd94, 0xc2c21634, + 0xbbcbee56, 0x90bcb6de, 0xebfc7da1, 0xce591d76, 0x6f05e409, 0x4b7c0188, + 0x39720a3d, 0x7c927c24, 0x86e3725f, 0x724d9db9, 0x1ac15bb4, 0xd39eb8fc, + 0xed545578, 0x08fca5b5, 0xd83d7cd3, 0x4dad0fc4, 0x1e50ef5e, 0xb161e6f8, + 0xa28514d9, 0x6c51133c, 0x6fd5c7e7, 0x56e14ec4, 0x362abfce, 0xddc6c837, + 0xd79a3234, 0x92638212, 0x670efa8e, 0x406000e0]) + +iSbox3 :: Sbox +iSbox3 = array (0,255) (zip [0..255] + [0x3a39ce37, 0xd3faf5cf, 0xabc27737, 0x5ac52d1b, 0x5cb0679e, 0x4fa33742, + 0xd3822740, 0x99bc9bbe, 0xd5118e9d, 0xbf0f7315, 0xd62d1c7e, 0xc700c47b, + 0xb78c1b6b, 0x21a19045, 0xb26eb1be, 0x6a366eb4, 0x5748ab2f, 0xbc946e79, + 0xc6a376d2, 0x6549c2c8, 0x530ff8ee, 0x468dde7d, 0xd5730a1d, 0x4cd04dc6, + 0x2939bbdb, 0xa9ba4650, 0xac9526e8, 0xbe5ee304, 0xa1fad5f0, 0x6a2d519a, + 0x63ef8ce2, 0x9a86ee22, 0xc089c2b8, 0x43242ef6, 0xa51e03aa, 0x9cf2d0a4, + 0x83c061ba, 0x9be96a4d, 0x8fe51550, 0xba645bd6, 0x2826a2f9, 0xa73a3ae1, + 0x4ba99586, 0xef5562e9, 0xc72fefd3, 0xf752f7da, 0x3f046f69, 0x77fa0a59, + 0x80e4a915, 0x87b08601, 0x9b09e6ad, 0x3b3ee593, 0xe990fd5a, 0x9e34d797, + 0x2cf0b7d9, 0x022b8b51, 0x96d5ac3a, 0x017da67d, 0xd1cf3ed6, 0x7c7d2d28, + 0x1f9f25cf, 0xadf2b89b, 0x5ad6b472, 0x5a88f54c, 0xe029ac71, 0xe019a5e6, + 0x47b0acfd, 0xed93fa9b, 0xe8d3c48d, 0x283b57cc, 0xf8d56629, 0x79132e28, + 0x785f0191, 0xed756055, 0xf7960e44, 0xe3d35e8c, 0x15056dd4, 0x88f46dba, + 0x03a16125, 0x0564f0bd, 0xc3eb9e15, 0x3c9057a2, 0x97271aec, 0xa93a072a, + 0x1b3f6d9b, 0x1e6321f5, 0xf59c66fb, 0x26dcf319, 0x7533d928, 0xb155fdf5, + 0x03563482, 0x8aba3cbb, 0x28517711, 0xc20ad9f8, 0xabcc5167, 0xccad925f, + 0x4de81751, 0x3830dc8e, 0x379d5862, 0x9320f991, 0xea7a90c2, 0xfb3e7bce, + 0x5121ce64, 0x774fbe32, 0xa8b6e37e, 0xc3293d46, 0x48de5369, 0x6413e680, + 0xa2ae0810, 0xdd6db224, 0x69852dfd, 0x09072166, 0xb39a460a, 0x6445c0dd, + 0x586cdecf, 0x1c20c8ae, 0x5bbef7dd, 0x1b588d40, 0xccd2017f, 0x6bb4e3bb, + 0xdda26a7e, 0x3a59ff45, 0x3e350a44, 0xbcb4cdd5, 0x72eacea8, 0xfa6484bb, + 0x8d6612ae, 0xbf3c6f47, 0xd29be463, 0x542f5d9e, 0xaec2771b, 0xf64e6370, + 0x740e0d8d, 0xe75b1357, 0xf8721671, 0xaf537d5d, 0x4040cb08, 0x4eb4e2cc, + 0x34d2466a, 0x0115af84, 0xe1b00428, 0x95983a1d, 0x06b89fb4, 0xce6ea048, + 0x6f3f3b82, 0x3520ab82, 0x011a1d4b, 0x277227f8, 0x611560b1, 0xe7933fdc, + 0xbb3a792b, 0x344525bd, 0xa08839e1, 0x51ce794b, 0x2f32c9b7, 0xa01fbac9, + 0xe01cc87e, 0xbcc7d1f6, 0xcf0111c3, 0xa1e8aac7, 0x1a908749, 0xd44fbd9a, + 0xd0dadecb, 0xd50ada38, 0x0339c32a, 0xc6913667, 0x8df9317c, 0xe0b12b4f, + 0xf79e59b7, 0x43f5bb3a, 0xf2d519ff, 0x27d9459c, 0xbf97222c, 0x15e6fc2a, + 0x0f91fc71, 0x9b941525, 0xfae59361, 0xceb69ceb, 0xc2a86459, 0x12baa8d1, + 0xb6c1075e, 0xe3056a0c, 0x10d25065, 0xcb03a442, 0xe0ec6e0e, 0x1698db3b, + 0x4c98a0be, 0x3278e964, 0x9f1f9532, 0xe0d392df, 0xd3a0342b, 0x8971f21e, + 0x1b0a7441, 0x4ba3348c, 0xc5be7120, 0xc37632d8, 0xdf359f8d, 0x9b992f2e, + 0xe60b6f47, 0x0fe3f11d, 0xe54cda54, 0x1edad891, 0xce6279cf, 0xcd3e7e6f, + 0x1618b166, 0xfd2c1d05, 0x848fd2c5, 0xf6fb2299, 0xf523f357, 0xa6327623, + 0x93a83531, 0x56cccd02, 0xacf08162, 0x5a75ebb5, 0x6e163697, 0x88d273cc, + 0xde966292, 0x81b949d0, 0x4c50901b, 0x71c65614, 0xe6c6c7bd, 0x327a140a, + 0x45e1d006, 0xc3f27b9a, 0xc9aa53fd, 0x62a80f00, 0xbb25bfe2, 0x35bdd2f6, + 0x71126905, 0xb2040222, 0xb6cbcf7c, 0xcd769c2b, 0x53113ec0, 0x1640e3d3, + 0x38abbd60, 0x2547adf0, 0xba38209c, 0xf746ce76, 0x77afa1c5, 0x20756060, + 0x85cbfe4e, 0x8ae88dd8, 0x7aaaf9b0, 0x4cf9aa7e, 0x1948c25c, 0x02fb8a8c, + 0x01c36ae4, 0xd6ebe1f9, 0x90d4f869, 0xa65cdea0, 0x3f09252d, 0xc208e69f, + 0xb74e6132, 0xce77e25b, 0x578fdfe3, 0x3ac372e6]) ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -127,3 +127,4 @@ test('T21710a', [ unless(tables_next_to_code(), skip) , when(wordsize(32), skip) , only_ways(['optasm']) , grep_errmsg('(call)',[1]) ] , compile, ['-ddump-cmm -dno-typeable-binds']) +test('T23002', normal, compile, ['-fregs-graph']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/68dd64ffa6f164dce4ac010b9f5e1adfefeae7c7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/68dd64ffa6f164dce4ac010b9f5e1adfefeae7c7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 03:45:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 02 Mar 2023 22:45:30 -0500 Subject: [Git][ghc/ghc][master] Get the right in-scope set in etaBodyForJoinPoint Message-ID: <64016d5a39479_3ab52bdeb28ac35525c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 3 changed files: - compiler/GHC/Core/Opt/Arity.hs - + testsuite/tests/simplCore/should_compile/T23026.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3105,7 +3105,7 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs -- Adds as many binders as asked for; assumes expr is not a lambda etaBodyForJoinPoint :: Int -> CoreExpr -> ([CoreBndr], CoreExpr) etaBodyForJoinPoint need_args body - = go need_args (exprType body) (init_subst body) [] body + = go need_args body_ty (mkEmptySubst in_scope) [] body where go 0 _ _ rev_bs e = (reverse rev_bs, e) @@ -3124,9 +3124,16 @@ etaBodyForJoinPoint need_args body = pprPanic "etaBodyForJoinPoint" $ int need_args $$ ppr body $$ ppr (exprType body) - init_subst e = mkEmptySubst (mkInScopeSet (exprFreeVars e)) - - + body_ty = exprType body + in_scope = mkInScopeSet (exprFreeVars body `unionVarSet` tyCoVarsOfType body_ty) + -- in_scope is a bit tricky. + -- - We are wrapping `body` in some value lambdas, so must not shadow + -- any free vars of `body` + -- - We are wrapping `body` in some type lambdas, so must not shadow any + -- tyvars in body_ty. Example: body is just a variable + -- (g :: forall (a::k). T k a -> Int) + -- We must not shadown that `k` when adding the /\a. So treat the free vars + -- of body_ty as in-scope. Showed up in #23026. -------------- freshEtaId :: Int -> Subst -> Scaled Type -> (Subst, Id) ===================================== testsuite/tests/simplCore/should_compile/T23026.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} + +module T23026 where + +import Data.Kind (Type) + +data Sing (a :: k) +data SingInstance (a :: k) = SingInstance (Sing a) + +app :: (Sing a -> SingInstance a) -> Sing a -> SingInstance a +app f x = f x +{-# NOINLINE app #-} + +withSomeSing + :: forall k2 k1 (f :: k2 -> k1 -> Type) a2 a1. + (Sing a2, Sing a1) + -> f a2 a1 + -> (forall b2 b1. f b2 b1 -> Int) + -> Int +withSomeSing (sa2, sa1) x g = + case app SingInstance sa2 of + SingInstance _ -> + case app SingInstance sa1 of + SingInstance _ -> g x +{-# INLINABLE withSomeSing #-} ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -476,3 +476,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) +test('T23026', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f97c86151d7eed115ddcbdee1842684aed63176 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f97c86151d7eed115ddcbdee1842684aed63176 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 08:12:36 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 03 Mar 2023 03:12:36 -0500 Subject: [Git][ghc/ghc][wip/T22023] 10 commits: Don't suppress *all* Wanteds Message-ID: <6401abf42ef56_3ab52b123ac7643758de@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22023 at Glasgow Haskell Compiler / GHC Commits: 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 53c4b80a by Simon Peyton Jones at 2023-03-03T08:13:44+00:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 30 changed files: - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Types/Constraint.hs - rts/Capability.c - rts/Capability.h - rts/RtsUtils.c - rts/RtsUtils.h - + testsuite/tests/codeGen/should_compile/T23002.hs - testsuite/tests/codeGen/should_compile/all.T - + testsuite/tests/ffi/should_compile/T22774.hs - testsuite/tests/ffi/should_compile/all.T - + testsuite/tests/gadt/T23022.hs - + testsuite/tests/gadt/T23023.hs - testsuite/tests/gadt/all.T - + testsuite/tests/numeric/should_compile/T23019.hs - testsuite/tests/numeric/should_compile/all.T - + testsuite/tests/simplCore/should_compile/T23026.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T22707.hs - + testsuite/tests/typecheck/should_fail/T22707.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -73,6 +73,7 @@ regUsageOfInstr :: Platform -> Instr -> RegUsage regUsageOfInstr platform instr = case instr of ANN _ i -> regUsageOfInstr platform i COMMENT{} -> usage ([], []) + MULTILINE_COMMENT{} -> usage ([], []) PUSH_STACK_FRAME -> usage ([], []) POP_STACK_FRAME -> usage ([], []) DELTA{} -> usage ([], []) @@ -207,11 +208,12 @@ callerSavedRegisters patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr patchRegsOfInstr instr env = case instr of -- 0. Meta Instructions - ANN d i -> ANN d (patchRegsOfInstr i env) - COMMENT{} -> instr - PUSH_STACK_FRAME -> instr - POP_STACK_FRAME -> instr - DELTA{} -> instr + ANN d i -> ANN d (patchRegsOfInstr i env) + COMMENT{} -> instr + MULTILINE_COMMENT{} -> instr + PUSH_STACK_FRAME -> instr + POP_STACK_FRAME -> instr + DELTA{} -> instr -- 1. Arithmetic Instructions ---------------------------------------------- ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1669,13 +1669,25 @@ dataConOtherTheta dc = dcOtherTheta dc -- evidence, after any flattening has been done and without substituting for -- any type variables dataConRepArgTys :: DataCon -> [Scaled Type] -dataConRepArgTys (MkData { dcRep = rep - , dcEqSpec = eq_spec +dataConRepArgTys (MkData { dcRep = rep + , dcEqSpec = eq_spec , dcOtherTheta = theta - , dcOrigArgTys = orig_arg_tys }) + , dcOrigArgTys = orig_arg_tys + , dcRepTyCon = tc }) = case rep of - NoDataConRep -> assert (null eq_spec) $ map unrestricted theta ++ orig_arg_tys DCR { dcr_arg_tys = arg_tys } -> arg_tys + NoDataConRep + | isTypeDataTyCon tc -> assert (null theta) $ + orig_arg_tys + -- `type data` declarations can be GADTs (and hence have an eq_spec) + -- but no wrapper. They cannot have a theta. + -- See Note [Type data declarations] in GHC.Rename.Module + -- You might wonder why we ever call dataConRepArgTys for `type data`; + -- I think it's because of the call in mkDataCon, which in turn feeds + -- into dcRepArity, which in turn is used in mkDataConWorkId. + -- c.f. #23022 + | otherwise -> assert (null eq_spec) $ + map unrestricted theta ++ orig_arg_tys -- | The string @package:module.name@ identifying a constructor, which is attached -- to its info table and used by the GHCi debugger and the heap profiler ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1021,6 +1021,9 @@ lintIdOcc var nargs ; checkDeadIdOcc var ; checkJoinOcc var nargs + ; case isDataConId_maybe var of + Nothing -> return () + Just dc -> checkTypeDataConOcc "expression" dc ; usage <- varCallSiteUsage var @@ -1107,6 +1110,13 @@ checkJoinOcc var n_args | otherwise = return () +checkTypeDataConOcc :: String -> DataCon -> LintM () +-- Check that the Id is not a data constructor of a `type data` declaration +-- Invariant (I1) of Note [Type data declarations] in GHC.Rename.Module +checkTypeDataConOcc what dc + = checkL (not (isTypeDataTyCon (dataConTyCon dc))) $ + (text "type data constructor found in a" <+> text what <> colon <+> ppr dc) + -- | This function checks that we are able to perform eta expansion for -- functions with no binding, in order to satisfy invariant I3 -- from Note [Representation polymorphism invariants] in GHC.Core. @@ -1561,10 +1571,11 @@ lintCoreAlt case_bndr scrut_ty _scrut_mult alt_ty alt@(Alt (DataAlt con) args rh = zeroUE <$ addErrL (mkNewTyDataConAltMsg scrut_ty alt) | Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty = addLoc (CaseAlt alt) $ do - { -- First instantiate the universally quantified - -- type variables of the data constructor - -- We've already check - lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + { checkTypeDataConOcc "pattern" con + ; lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + + -- Instantiate the universally quantified + -- type variables of the data constructor ; let { con_payload_ty = piResultTys (dataConRepType con) tycon_arg_tys ; binderMult (Named _) = ManyTy ; binderMult (Anon st _) = scaledMult st ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -3105,7 +3105,7 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs -- Adds as many binders as asked for; assumes expr is not a lambda etaBodyForJoinPoint :: Int -> CoreExpr -> ([CoreBndr], CoreExpr) etaBodyForJoinPoint need_args body - = go need_args (exprType body) (init_subst body) [] body + = go need_args body_ty (mkEmptySubst in_scope) [] body where go 0 _ _ rev_bs e = (reverse rev_bs, e) @@ -3124,9 +3124,16 @@ etaBodyForJoinPoint need_args body = pprPanic "etaBodyForJoinPoint" $ int need_args $$ ppr body $$ ppr (exprType body) - init_subst e = mkEmptySubst (mkInScopeSet (exprFreeVars e)) - - + body_ty = exprType body + in_scope = mkInScopeSet (exprFreeVars body `unionVarSet` tyCoVarsOfType body_ty) + -- in_scope is a bit tricky. + -- - We are wrapping `body` in some value lambdas, so must not shadow + -- any free vars of `body` + -- - We are wrapping `body` in some type lambdas, so must not shadow any + -- tyvars in body_ty. Example: body is just a variable + -- (g :: forall (a::k). T k a -> Int) + -- We must not shadown that `k` when adding the /\a. So treat the free vars + -- of body_ty as in-scope. Showed up in #23026. -------------- freshEtaId :: Int -> Subst -> Scaled Type -> (Subst, Id) ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, tyConDataCons - , tyConFamilySize ) + , tyConFamilySize, isTypeDataTyCon ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey ) @@ -1110,14 +1110,10 @@ doubleOp2 _ _ _ _ = Nothing -------------------------- doubleDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr doubleDecodeOp env (LitDouble ((decodeFloat . fromRational @Double) -> (m, e))) - = Just $ mkCoreUnboxedTuple [ Lit (mkLitINT64 (toInteger m)) + = Just $ mkCoreUnboxedTuple [ Lit (mkLitInt64Wrap (toInteger m)) , mkIntVal platform (toInteger e) ] where platform = roPlatform env - mkLitINT64 | platformWordSizeInBits platform < 64 - = mkLitInt64Wrap - | otherwise - = mkLitIntWrap platform doubleDecodeOp _ _ = Nothing @@ -3188,6 +3184,8 @@ caseRules _ (App (App (Var f) (Type ty)) v) -- dataToTag x | Just DataToTagOp <- isPrimOpId_maybe f , Just (tc, _) <- tcSplitTyConApp_maybe ty , isAlgTyCon tc + , not (isTypeDataTyCon tc) -- See wrinkle (W2c) in GHC.Rename.Module + -- Note [Type data declarations] = Just (v, tx_con_dtt ty , \v -> App (App (Var f) (Type ty)) (Var v)) ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -845,7 +845,8 @@ There are two exceptions where we avoid refining a DEFAULT case: __DEFAULT -> () Namely, we do _not_ want to match on `A`, as it doesn't exist at the value - level! + level! See wrinkle (W2b) in Note [Type data declarations] in GHC.Rename.Module + Note [Combine identical alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -152,8 +152,8 @@ vanillaCompleteMatchTC tc = tc == tYPETyCon = Just [] | -- Similarly, treat `type data` declarations as empty data types on -- the term level, as `type data` data constructors only exist at - -- the type level (#22964). - -- See Note [Type data declarations] in GHC.Rename.Module. + -- the type level (#22964). See wrinkle (W2a) in + -- Note [Type data declarations] in GHC.Rename.Module. isTypeDataTyCon tc = Just [] | otherwise = tyConDataCons_maybe tc in vanillaCompleteMatch . mkUniqDSet . map RealDataCon <$> mb_dcs ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2073,9 +2073,79 @@ preceded by `type`, with the following restrictions: (R5) There are no deriving clauses. +The data constructors of a `type data` declaration obey the following +Core invariant: + +(I1) The data constructors of a `type data` declaration may be mentioned in + /types/, but never in /terms/ or the /pattern of a case alternative/. + +Wrinkles: + +(W0) Wrappers. The data constructor of a `type data` declaration has a worker + (like every data constructor) but does /not/ have a wrapper. Wrappers + only make sense for value-level data constructors. Indeed, the worker Id + is never used (invariant (I1)), so it barely makes sense to talk about + the worker. A `type data` constructor only shows up in types, where it + appears as a TyCon, specifically a PromotedDataCon -- no Id in sight. + + See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where + this check is implemented. + + This specifically includes `type data` declarations implemented as GADTs, + such as this example from #22948: + + type data T a where + A :: T Int + B :: T a + + If `T` were an ordinary `data` declaration, then `A` would have a wrapper + to account for the GADT-like equality in its return type. Because `T` is + declared as a `type data` declaration, however, the wrapper is omitted. + +(W1) To prevent users from conjuring up `type data` values at the term level, + we disallow using the tagToEnum# function on a type headed by a `type + data` type. For instance, GHC will reject this code: + + type data Letter = A | B | C + + f :: Letter + f = tagToEnum# 0# + + See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. + +(W2) Although `type data` data constructors do not exist at the value level, + it is still possible to match on a value whose type is headed by a `type data` + type constructor, such as this example from #22964: + + type data T a where + A :: T Int + B :: T a + + f :: T a -> () + f x = case x of {} + + And yet we must guarantee invariant (I1). This has three consequences: + + (W2a) During checking the coverage of `f`'s pattern matches, we treat `T` + as if it were an empty data type so that GHC does not warn the user + to match against `A` or `B`. (Otherwise, you end up with the bug + reported in #22964.) See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. + + (W2b) In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case + with the data constructor, else (I1) is violated. See GHC.Core.Utils + Note [Refine DEFAULT case alternatives] Exception 2 + + (W2c) In `GHC.Core.Opt.ConstantFold.caseRules`, disable the rule for + `dataToTag#` in the case of `type data`. We do not want to transform + case dataToTag# x of t -> blah + into + case x of { A -> ...; B -> .. } + because again that conjures up the type-level-only data contructors + `A` and `B` in a pattern, violating (I1) (#23023). + The main parts of the implementation are: -* (R0): The parser recognizes `type data` (but not `type newtype`). +* The parser recognizes `type data` (but not `type newtype`); this ensures (R0). * During the initial construction of the AST, GHC.Parser.PostProcess.checkNewOrData sets the `Bool` argument of the @@ -2134,54 +2204,6 @@ The main parts of the implementation are: `type data` declarations. When these are converted back to Hs types in a splice, the constructors are placed in the TcCls namespace. -* A `type data` declaration _never_ generates wrappers for its data - constructors, as they only make sense for value-level data constructors. - See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where - this check is implemented. - - This includes `type data` declarations implemented as GADTs, such as - this example from #22948: - - type data T a where - A :: T Int - B :: T a - - If `T` were an ordinary `data` declaration, then `A` would have a wrapper - to account for the GADT-like equality in its return type. Because `T` is - declared as a `type data` declaration, however, the wrapper is omitted. - -* Although `type data` data constructors do not exist at the value level, - it is still possible to match on a value whose type is headed by a `type data` - type constructor, such as this example from #22964: - - type data T a where - A :: T Int - B :: T a - - f :: T a -> () - f x = case x of {} - - This has two consequences: - - * During checking the coverage of `f`'s pattern matches, we treat `T` as if it - were an empty data type so that GHC does not warn the user to match against - `A` or `B`. (Otherwise, you end up with the bug reported in #22964.) - See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. - - * In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case with - the data constructor. See - Note [Refine DEFAULT case alternatives] Exception 2, in GHC.Core.Utils. - -* To prevent users from conjuring up `type data` values at the term level, we - disallow using the tagToEnum# function on a type headed by a `type data` - type. For instance, GHC will reject this code: - - type data Letter = A | B | C - - f :: Letter - f = tagToEnum# 0# - - See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -476,30 +476,37 @@ mkErrorItem ct , ei_m_reason = m_reason , ei_suppress = suppress }} +-- | Actually report this 'ErrorItem'. +unsuppressErrorItem :: ErrorItem -> ErrorItem +unsuppressErrorItem ei = ei { ei_suppress = False } + ---------------------------------------------------------------- reportWanteds :: SolverReportErrCtxt -> TcLevel -> WantedConstraints -> TcM () reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics , wc_errors = errs }) | isEmptyWC wc = traceTc "reportWanteds empty WC" empty | otherwise - = do { tidy_items <- mapMaybeM mkErrorItem tidy_cts + = do { tidy_items1 <- mapMaybeM mkErrorItem tidy_cts ; traceTc "reportWanteds 1" (vcat [ text "Simples =" <+> ppr simples , text "Suppress =" <+> ppr (cec_suppress ctxt) , text "tidy_cts =" <+> ppr tidy_cts - , text "tidy_items =" <+> ppr tidy_items + , text "tidy_items1 =" <+> ppr tidy_items1 , text "tidy_errs =" <+> ppr tidy_errs ]) - -- This check makes sure that we aren't suppressing the only error that will - -- actually stop compilation - ; assertPprM - ( do { errs_already <- ifErrsM (return True) (return False) - ; return $ - errs_already || -- we already reported an error (perhaps from an outer implication) - null simples || -- no errors to report here - any ignoreConstraint simples || -- one error is ignorable (is reported elsewhere) - not (all ei_suppress tidy_items) -- not all errors are suppressed - } ) - (vcat [text "reportWanteds is suppressing all errors"]) + -- Catch an awkward case in which /all/ errors are suppressed: + -- see Wrinkle at end of Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint + -- Unless we are sure that an error will be reported some other way (details + -- in the defn of tidy_items) un-suppress the lot. This makes sure we don't forget to + -- report an error at all, which is catastrophic: GHC proceeds to desguar and optimise + -- the program, even though it is full of type errors (#22702, #22793) + ; errs_already <- ifErrsM (return True) (return False) + ; let tidy_items + | not errs_already -- Have not already reported an error (perhaps + -- from an outer implication); see #21405 + , not (any ignoreConstraint simples) -- No error is ignorable (is reported elsewhere) + , all ei_suppress tidy_items1 -- All errors are suppressed + = map unsuppressErrorItem tidy_items1 + | otherwise = tidy_items1 -- First, deal with any out-of-scope errors: ; let (out_of_scope, other_holes, not_conc_errs) = partition_errors tidy_errs ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -1222,7 +1222,8 @@ tcTagToEnum tc_fun fun_ctxt tc_args res_ty vanilla_result = rebuildHsApps tc_fun fun_ctxt tc_args res_ty check_enumeration ty' tc - | -- isTypeDataTyCon: see Note [Type data declarations] in GHC.Rename.Module + | -- isTypeDataTyCon: see wrinkle (W1) in + -- Note [Type data declarations] in GHC.Rename.Module isTypeDataTyCon tc = addErrTc (TcRnTagToEnumResTyTypeData ty') | isEnumerationTyCon tc = return () | otherwise = addErrTc (TcRnTagToEnumResTyNotAnEnum ty') ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -341,9 +341,10 @@ tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) (L ls safety) mh checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty return (CImport src (L lc cconv) (L ls safety) mh (CFunction target)) | cconv == JavaScriptCallConv = do + cconv' <- checkCConv (Right idecl) cconv checkCg (Right idecl) backendValidityOfCImport -- leave the rest to the JS backend (at least for now) - return (CImport src (L lc cconv) (L ls safety) mh (CFunction target)) + return (CImport src (L lc cconv') (L ls safety) mh (CFunction target)) | otherwise = do -- Normal foreign import checkCg (Right idecl) backendValidityOfCImport cconv' <- checkCConv (Right idecl) cconv ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -2127,10 +2127,10 @@ uses GHC.Tc.Utils.anyUnfilledCoercionHoles to look through any filled coercion holes. The idea is that we wish to report the "root cause" -- the error that rewrote all the others. -Worry: It seems possible that *all* unsolved wanteds are rewritten by other -unsolved wanteds, so that e.g. w1 has w2 in its rewriter set, and w2 has -w1 in its rewiter set. We are unable to come up with an example of this in -practice, however, and so we believe this case cannot happen. +Wrinkle: In #22707, we have a case where all of the Wanteds have rewritten +each other. In order to report /some/ error in this case, we simply report +all the Wanteds. The user will get a perhaps-confusing error message, but +they've written a confusing program! Note [Avoiding rewriting cycles] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== rts/Capability.c ===================================== @@ -438,8 +438,9 @@ moreCapabilities (uint32_t from USED_IF_THREADS, uint32_t to USED_IF_THREADS) { for (uint32_t i = 0; i < to; i++) { if (i >= from) { - capabilities[i] = stgMallocBytes(sizeof(Capability), - "moreCapabilities"); + capabilities[i] = stgMallocAlignedBytes(sizeof(Capability), + CAPABILITY_ALIGNMENT, + "moreCapabilities"); initCapability(capabilities[i], i); } } @@ -1274,7 +1275,7 @@ freeCapabilities (void) Capability *cap = getCapability(i); freeCapability(cap); if (cap != &MainCapability) { - stgFree(cap); + stgFreeAligned(cap); } } #else ===================================== rts/Capability.h ===================================== @@ -28,6 +28,14 @@ #include "BeginPrivate.h" +// We never want a Capability to overlap a cache line with +// anything else, so round it up to a cache line size: +#if defined(s390x_HOST_ARCH) +#define CAPABILITY_ALIGNMENT 256 +#else +#define CAPABILITY_ALIGNMENT 64 +#endif + /* N.B. This must be consistent with CapabilityPublic in RtsAPI.h */ struct Capability_ { // State required by the STG virtual machine when running Haskell @@ -169,14 +177,12 @@ struct Capability_ { StgTRecHeader *free_trec_headers; uint32_t transaction_tokens; } // typedef Capability is defined in RtsAPI.h - // We never want a Capability to overlap a cache line with anything - // else, so round it up to a cache line size: -#if defined(s390x_HOST_ARCH) - ATTRIBUTE_ALIGNED(256) -#elif !defined(mingw32_HOST_OS) - ATTRIBUTE_ALIGNED(64) -#endif - ; + ATTRIBUTE_ALIGNED(CAPABILITY_ALIGNMENT) +; + +// We allocate arrays of Capabilities therefore we must ensure that the size is +// a multiple of the claimed alignment +GHC_STATIC_ASSERT(sizeof(struct Capability_) % CAPABILITY_ALIGNMENT == 0, "Capability size does not match cache size"); #if defined(THREADED_RTS) #define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId()) ===================================== rts/RtsUtils.c ===================================== @@ -57,9 +57,9 @@ extern char *ctime_r(const time_t *, char *); void * stgMallocBytes (size_t n, char *msg) { - void *space; + void *space = malloc(n); - if ((space = malloc(n)) == NULL) { + if (space == NULL) { /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): * * "Upon successful completion with size not equal to 0, malloc() shall @@ -128,6 +128,53 @@ stgFree(void* p) free(p); } +// N.B. Allocations resulting from this function must be freed by +// `stgFreeAligned`, not `stgFree`. This is necessary due to the properties of Windows' `_aligned_malloc` +void * +stgMallocAlignedBytes (size_t n, size_t align, char *msg) +{ + void *space; + +#if defined(mingw32_HOST_OS) + space = _aligned_malloc(n, align); +#else + if (posix_memalign(&space, align, n)) { + space = NULL; // Allocation failed + } +#endif + + if (space == NULL) { + /* Quoting POSIX.1-2008 (which says more or less the same as ISO C99): + * + * "Upon successful completion with size not equal to 0, malloc() shall + * return a pointer to the allocated space. If size is 0, either a null + * pointer or a unique pointer that can be successfully passed to free() + * shall be returned. Otherwise, it shall return a null pointer and set + * errno to indicate the error." + * + * Consequently, a NULL pointer being returned by `malloc()` for a 0-size + * allocation is *not* to be considered an error. + */ + if (n == 0) return NULL; + + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + rtsConfig.mallocFailHook((W_) n, msg); + stg_exit(EXIT_INTERNAL_ERROR); + } + IF_DEBUG(zero_on_gc, memset(space, 0xbb, n)); + return space; +} + +void +stgFreeAligned (void *p) +{ +#if defined(mingw32_HOST_OS) + _aligned_free(p); +#else + free(p); +#endif +} + /* ----------------------------------------------------------------------------- Stack/heap overflow -------------------------------------------------------------------------- */ ===================================== rts/RtsUtils.h ===================================== @@ -29,16 +29,9 @@ void *stgMallocBytes(size_t n, char *msg) * See: https://gitlab.haskell.org/ghc/ghc/-/issues/22380 */ -void *stgReallocBytes(void *p, size_t n, char *msg) - STG_MALLOC1(stgFree) - STG_ALLOC_SIZE1(2) - STG_RETURNS_NONNULL; -/* Note: `stgRallocBytes` can *not* be tagged as `STG_MALLOC` - * since its return value *can* alias an existing pointer (i.e., - * the given pointer `p`). - * See the documentation of the `malloc` attribute in the GCC manual - * for more information. - */ +void *stgMallocAlignedBytes(size_t n, size_t align, char *msg); + +void *stgReallocBytes(void *p, size_t n, char *msg); void *stgCallocBytes(size_t count, size_t size, char *msg) STG_MALLOC STG_MALLOC1(stgFree) @@ -48,6 +41,10 @@ void *stgCallocBytes(size_t count, size_t size, char *msg) char *stgStrndup(const char *s, size_t n) STG_MALLOC STG_MALLOC1(stgFree); +void *stgMallocAlignedBytes(size_t n, size_t align, char *msg); + +void stgFreeAligned(void *p); + /* ----------------------------------------------------------------------------- * Misc other utilities * -------------------------------------------------------------------------- */ ===================================== testsuite/tests/codeGen/should_compile/T23002.hs ===================================== @@ -0,0 +1,257 @@ +module T23002 + (bfMakeKey, + bfEnc, + bfDec) where + +import Data.Array +import Data.Bits +import Data.Word +import Data.Char + +type Pbox = Array Word32 Word32 +type Sbox = Array Word32 Word32 + +data BF = BF Pbox Sbox Sbox Sbox Sbox + +bfEnc :: BF -> [Word32] -> [Word32] +bfEnc a b = aux a b 0 + where + aux :: BF -> [Word32] -> Word32 -> [Word32] + aux bs@(BF p s0 s1 s2 s3) (l:r:[]) 16 = (r `xor` p!17):(l `xor` p!16):[] + aux bs@(BF p s0 s1 s2 s3) (l:r:[]) i = aux bs (newr:newl:[]) (i+1) + where newl = l `xor` (p ! i) + newr = r `xor` (f newl) + f :: Word32 -> Word32 + f t = ((s0!a + s1!b) `xor` (s2 ! c)) + (s3 ! d) + where a = (t `shiftR` 24) + b = ((t `shiftL` 8) `shiftR` 24) + c = ((t `shiftL` 16) `shiftR` 24) + d = ((t `shiftL` 24) `shiftR` 24) + + +bfDec :: BF -> [Word32] -> [Word32] +bfDec (BF p s0 s1 s2 s3) a = bfEnc (BF (revP p) s0 s1 s2 s3) a + where revP :: Pbox -> Pbox + revP x = x//[(i, x ! (17-i)) | i <- [0..17]] + +bfMakeKey :: [Char] -> BF +bfMakeKey [] = procKey [0,0] (BF iPbox iSbox0 iSbox1 iSbox2 iSbox3) 0 +bfMakeKey k = procKey [0,0] (BF (string2Pbox k) iSbox0 iSbox1 iSbox2 iSbox3) 0 + +string2Pbox :: [Char] -> Pbox +string2Pbox k = array (0,17) [(fromIntegral i,xtext!!i) | i <- [0..17]] + where xtext = zipWith (xor) + (compress4 (doShift (makeTo72 (charsToWord32s k) 0) 0)) + [iPbox ! (fromIntegral i) | i <- [0..17]] + charsToWord32s [] = [] + charsToWord32s (k:ks) = (fromIntegral $ fromEnum k) : charsToWord32s ks + makeTo72 k 72 = [] + makeTo72 k i = k!!(i `mod` (length k)) : makeTo72 k (i+1) + doShift [] i = [] + doShift (w:ws) i = w `shiftL` (8*(3 - (i `mod` 4))) : doShift ws (i+1) + compress4 [] = [] + compress4 (a:b:c:d:etc) = (a .|. b .|. c .|. d) : compress4 etc + +procKey :: [Word32] -> BF -> Word32 -> BF +procKey (l:r:[]) tpbf@(BF p s0 s1 s2 s3) 1042 = tpbf +procKey (l:r:[]) tpbf@(BF p s0 s1 s2 s3) i = procKey [nl,nr] (newbf i) (i+2) + where [nl,nr] = bfEnc tpbf [l,r] + newbf x | x < 18 = (BF (p//[(x,nl),(x+1,nr)]) s0 s1 s2 s3) + | x < 274 = (BF p (s0//[(x-18,nl),(x-17,nr)]) s1 s2 s3) + | x < 530 = (BF p s0 (s1//[(x-274,nl),(x-273,nr)]) s2 s3) + | x < 786 = (BF p s0 s1 (s2//[(x-530,nl),(x-529,nr)]) s3) + | x < 1042 = (BF p s0 s1 s2 (s3//[(x-786,nl),(x-785,nr)])) + + + +---------- INITIAL S AND P BOXES ARE THE HEXADECIMAL DIGITS OF PI ------------ + +iPbox :: Pbox +iPbox = array (0,17) (zip [0..17] + [0x243f6a88, 0x85a308d3, 0x13198a2e, 0x03707344, 0xa4093822, 0x299f31d0, + 0x082efa98, 0xec4e6c89, 0x452821e6, 0x38d01377, 0xbe5466cf, 0x34e90c6c, + 0xc0ac29b7, 0xc97c50dd, 0x3f84d5b5, 0xb5470917, 0x9216d5d9, 0x8979fb1b]) + +iSbox0 :: Sbox +iSbox0 = array (0,255) (zip [0..255] + [0xd1310ba6, 0x98dfb5ac, 0x2ffd72db, 0xd01adfb7, 0xb8e1afed, 0x6a267e96, + 0xba7c9045, 0xf12c7f99, 0x24a19947, 0xb3916cf7, 0x0801f2e2, 0x858efc16, + 0x636920d8, 0x71574e69, 0xa458fea3, 0xf4933d7e, 0x0d95748f, 0x728eb658, + 0x718bcd58, 0x82154aee, 0x7b54a41d, 0xc25a59b5, 0x9c30d539, 0x2af26013, + 0xc5d1b023, 0x286085f0, 0xca417918, 0xb8db38ef, 0x8e79dcb0, 0x603a180e, + 0x6c9e0e8b, 0xb01e8a3e, 0xd71577c1, 0xbd314b27, 0x78af2fda, 0x55605c60, + 0xe65525f3, 0xaa55ab94, 0x57489862, 0x63e81440, 0x55ca396a, 0x2aab10b6, + 0xb4cc5c34, 0x1141e8ce, 0xa15486af, 0x7c72e993, 0xb3ee1411, 0x636fbc2a, + 0x2ba9c55d, 0x741831f6, 0xce5c3e16, 0x9b87931e, 0xafd6ba33, 0x6c24cf5c, + 0x7a325381, 0x28958677, 0x3b8f4898, 0x6b4bb9af, 0xc4bfe81b, 0x66282193, + 0x61d809cc, 0xfb21a991, 0x487cac60, 0x5dec8032, 0xef845d5d, 0xe98575b1, + 0xdc262302, 0xeb651b88, 0x23893e81, 0xd396acc5, 0x0f6d6ff3, 0x83f44239, + 0x2e0b4482, 0xa4842004, 0x69c8f04a, 0x9e1f9b5e, 0x21c66842, 0xf6e96c9a, + 0x670c9c61, 0xabd388f0, 0x6a51a0d2, 0xd8542f68, 0x960fa728, 0xab5133a3, + 0x6eef0b6c, 0x137a3be4, 0xba3bf050, 0x7efb2a98, 0xa1f1651d, 0x39af0176, + 0x66ca593e, 0x82430e88, 0x8cee8619, 0x456f9fb4, 0x7d84a5c3, 0x3b8b5ebe, + 0xe06f75d8, 0x85c12073, 0x401a449f, 0x56c16aa6, 0x4ed3aa62, 0x363f7706, + 0x1bfedf72, 0x429b023d, 0x37d0d724, 0xd00a1248, 0xdb0fead3, 0x49f1c09b, + 0x075372c9, 0x80991b7b, 0x25d479d8, 0xf6e8def7, 0xe3fe501a, 0xb6794c3b, + 0x976ce0bd, 0x04c006ba, 0xc1a94fb6, 0x409f60c4, 0x5e5c9ec2, 0x196a2463, + 0x68fb6faf, 0x3e6c53b5, 0x1339b2eb, 0x3b52ec6f, 0x6dfc511f, 0x9b30952c, + 0xcc814544, 0xaf5ebd09, 0xbee3d004, 0xde334afd, 0x660f2807, 0x192e4bb3, + 0xc0cba857, 0x45c8740f, 0xd20b5f39, 0xb9d3fbdb, 0x5579c0bd, 0x1a60320a, + 0xd6a100c6, 0x402c7279, 0x679f25fe, 0xfb1fa3cc, 0x8ea5e9f8, 0xdb3222f8, + 0x3c7516df, 0xfd616b15, 0x2f501ec8, 0xad0552ab, 0x323db5fa, 0xfd238760, + 0x53317b48, 0x3e00df82, 0x9e5c57bb, 0xca6f8ca0, 0x1a87562e, 0xdf1769db, + 0xd542a8f6, 0x287effc3, 0xac6732c6, 0x8c4f5573, 0x695b27b0, 0xbbca58c8, + 0xe1ffa35d, 0xb8f011a0, 0x10fa3d98, 0xfd2183b8, 0x4afcb56c, 0x2dd1d35b, + 0x9a53e479, 0xb6f84565, 0xd28e49bc, 0x4bfb9790, 0xe1ddf2da, 0xa4cb7e33, + 0x62fb1341, 0xcee4c6e8, 0xef20cada, 0x36774c01, 0xd07e9efe, 0x2bf11fb4, + 0x95dbda4d, 0xae909198, 0xeaad8e71, 0x6b93d5a0, 0xd08ed1d0, 0xafc725e0, + 0x8e3c5b2f, 0x8e7594b7, 0x8ff6e2fb, 0xf2122b64, 0x8888b812, 0x900df01c, + 0x4fad5ea0, 0x688fc31c, 0xd1cff191, 0xb3a8c1ad, 0x2f2f2218, 0xbe0e1777, + 0xea752dfe, 0x8b021fa1, 0xe5a0cc0f, 0xb56f74e8, 0x18acf3d6, 0xce89e299, + 0xb4a84fe0, 0xfd13e0b7, 0x7cc43b81, 0xd2ada8d9, 0x165fa266, 0x80957705, + 0x93cc7314, 0x211a1477, 0xe6ad2065, 0x77b5fa86, 0xc75442f5, 0xfb9d35cf, + 0xebcdaf0c, 0x7b3e89a0, 0xd6411bd3, 0xae1e7e49, 0x00250e2d, 0x2071b35e, + 0x226800bb, 0x57b8e0af, 0x2464369b, 0xf009b91e, 0x5563911d, 0x59dfa6aa, + 0x78c14389, 0xd95a537f, 0x207d5ba2, 0x02e5b9c5, 0x83260376, 0x6295cfa9, + 0x11c81968, 0x4e734a41, 0xb3472dca, 0x7b14a94a, 0x1b510052, 0x9a532915, + 0xd60f573f, 0xbc9bc6e4, 0x2b60a476, 0x81e67400, 0x08ba6fb5, 0x571be91f, + 0xf296ec6b, 0x2a0dd915, 0xb6636521, 0xe7b9f9b6, 0xff34052e, 0xc5855664, + 0x53b02d5d, 0xa99f8fa1, 0x08ba4799, 0x6e85076a]) + +iSbox1 :: Sbox +iSbox1 = array (0,255) (zip [0..255] + [0x4b7a70e9, 0xb5b32944, 0xdb75092e, 0xc4192623, 0xad6ea6b0, 0x49a7df7d, + 0x9cee60b8, 0x8fedb266, 0xecaa8c71, 0x699a17ff, 0x5664526c, 0xc2b19ee1, + 0x193602a5, 0x75094c29, 0xa0591340, 0xe4183a3e, 0x3f54989a, 0x5b429d65, + 0x6b8fe4d6, 0x99f73fd6, 0xa1d29c07, 0xefe830f5, 0x4d2d38e6, 0xf0255dc1, + 0x4cdd2086, 0x8470eb26, 0x6382e9c6, 0x021ecc5e, 0x09686b3f, 0x3ebaefc9, + 0x3c971814, 0x6b6a70a1, 0x687f3584, 0x52a0e286, 0xb79c5305, 0xaa500737, + 0x3e07841c, 0x7fdeae5c, 0x8e7d44ec, 0x5716f2b8, 0xb03ada37, 0xf0500c0d, + 0xf01c1f04, 0x0200b3ff, 0xae0cf51a, 0x3cb574b2, 0x25837a58, 0xdc0921bd, + 0xd19113f9, 0x7ca92ff6, 0x94324773, 0x22f54701, 0x3ae5e581, 0x37c2dadc, + 0xc8b57634, 0x9af3dda7, 0xa9446146, 0x0fd0030e, 0xecc8c73e, 0xa4751e41, + 0xe238cd99, 0x3bea0e2f, 0x3280bba1, 0x183eb331, 0x4e548b38, 0x4f6db908, + 0x6f420d03, 0xf60a04bf, 0x2cb81290, 0x24977c79, 0x5679b072, 0xbcaf89af, + 0xde9a771f, 0xd9930810, 0xb38bae12, 0xdccf3f2e, 0x5512721f, 0x2e6b7124, + 0x501adde6, 0x9f84cd87, 0x7a584718, 0x7408da17, 0xbc9f9abc, 0xe94b7d8c, + 0xec7aec3a, 0xdb851dfa, 0x63094366, 0xc464c3d2, 0xef1c1847, 0x3215d908, + 0xdd433b37, 0x24c2ba16, 0x12a14d43, 0x2a65c451, 0x50940002, 0x133ae4dd, + 0x71dff89e, 0x10314e55, 0x81ac77d6, 0x5f11199b, 0x043556f1, 0xd7a3c76b, + 0x3c11183b, 0x5924a509, 0xf28fe6ed, 0x97f1fbfa, 0x9ebabf2c, 0x1e153c6e, + 0x86e34570, 0xeae96fb1, 0x860e5e0a, 0x5a3e2ab3, 0x771fe71c, 0x4e3d06fa, + 0x2965dcb9, 0x99e71d0f, 0x803e89d6, 0x5266c825, 0x2e4cc978, 0x9c10b36a, + 0xc6150eba, 0x94e2ea78, 0xa5fc3c53, 0x1e0a2df4, 0xf2f74ea7, 0x361d2b3d, + 0x1939260f, 0x19c27960, 0x5223a708, 0xf71312b6, 0xebadfe6e, 0xeac31f66, + 0xe3bc4595, 0xa67bc883, 0xb17f37d1, 0x018cff28, 0xc332ddef, 0xbe6c5aa5, + 0x65582185, 0x68ab9802, 0xeecea50f, 0xdb2f953b, 0x2aef7dad, 0x5b6e2f84, + 0x1521b628, 0x29076170, 0xecdd4775, 0x619f1510, 0x13cca830, 0xeb61bd96, + 0x0334fe1e, 0xaa0363cf, 0xb5735c90, 0x4c70a239, 0xd59e9e0b, 0xcbaade14, + 0xeecc86bc, 0x60622ca7, 0x9cab5cab, 0xb2f3846e, 0x648b1eaf, 0x19bdf0ca, + 0xa02369b9, 0x655abb50, 0x40685a32, 0x3c2ab4b3, 0x319ee9d5, 0xc021b8f7, + 0x9b540b19, 0x875fa099, 0x95f7997e, 0x623d7da8, 0xf837889a, 0x97e32d77, + 0x11ed935f, 0x16681281, 0x0e358829, 0xc7e61fd6, 0x96dedfa1, 0x7858ba99, + 0x57f584a5, 0x1b227263, 0x9b83c3ff, 0x1ac24696, 0xcdb30aeb, 0x532e3054, + 0x8fd948e4, 0x6dbc3128, 0x58ebf2ef, 0x34c6ffea, 0xfe28ed61, 0xee7c3c73, + 0x5d4a14d9, 0xe864b7e3, 0x42105d14, 0x203e13e0, 0x45eee2b6, 0xa3aaabea, + 0xdb6c4f15, 0xfacb4fd0, 0xc742f442, 0xef6abbb5, 0x654f3b1d, 0x41cd2105, + 0xd81e799e, 0x86854dc7, 0xe44b476a, 0x3d816250, 0xcf62a1f2, 0x5b8d2646, + 0xfc8883a0, 0xc1c7b6a3, 0x7f1524c3, 0x69cb7492, 0x47848a0b, 0x5692b285, + 0x095bbf00, 0xad19489d, 0x1462b174, 0x23820e00, 0x58428d2a, 0x0c55f5ea, + 0x1dadf43e, 0x233f7061, 0x3372f092, 0x8d937e41, 0xd65fecf1, 0x6c223bdb, + 0x7cde3759, 0xcbee7460, 0x4085f2a7, 0xce77326e, 0xa6078084, 0x19f8509e, + 0xe8efd855, 0x61d99735, 0xa969a7aa, 0xc50c06c2, 0x5a04abfc, 0x800bcadc, + 0x9e447a2e, 0xc3453484, 0xfdd56705, 0x0e1e9ec9, 0xdb73dbd3, 0x105588cd, + 0x675fda79, 0xe3674340, 0xc5c43465, 0x713e38d8, 0x3d28f89e, 0xf16dff20, + 0x153e21e7, 0x8fb03d4a, 0xe6e39f2b, 0xdb83adf7]) + +iSbox2 :: Sbox +iSbox2 = array (0,255) (zip [0..255] + [0xe93d5a68, 0x948140f7, 0xf64c261c, 0x94692934, 0x411520f7, 0x7602d4f7, + 0xbcf46b2e, 0xd4a20068, 0xd4082471, 0x3320f46a, 0x43b7d4b7, 0x500061af, + 0x1e39f62e, 0x97244546, 0x14214f74, 0xbf8b8840, 0x4d95fc1d, 0x96b591af, + 0x70f4ddd3, 0x66a02f45, 0xbfbc09ec, 0x03bd9785, 0x7fac6dd0, 0x31cb8504, + 0x96eb27b3, 0x55fd3941, 0xda2547e6, 0xabca0a9a, 0x28507825, 0x530429f4, + 0x0a2c86da, 0xe9b66dfb, 0x68dc1462, 0xd7486900, 0x680ec0a4, 0x27a18dee, + 0x4f3ffea2, 0xe887ad8c, 0xb58ce006, 0x7af4d6b6, 0xaace1e7c, 0xd3375fec, + 0xce78a399, 0x406b2a42, 0x20fe9e35, 0xd9f385b9, 0xee39d7ab, 0x3b124e8b, + 0x1dc9faf7, 0x4b6d1856, 0x26a36631, 0xeae397b2, 0x3a6efa74, 0xdd5b4332, + 0x6841e7f7, 0xca7820fb, 0xfb0af54e, 0xd8feb397, 0x454056ac, 0xba489527, + 0x55533a3a, 0x20838d87, 0xfe6ba9b7, 0xd096954b, 0x55a867bc, 0xa1159a58, + 0xcca92963, 0x99e1db33, 0xa62a4a56, 0x3f3125f9, 0x5ef47e1c, 0x9029317c, + 0xfdf8e802, 0x04272f70, 0x80bb155c, 0x05282ce3, 0x95c11548, 0xe4c66d22, + 0x48c1133f, 0xc70f86dc, 0x07f9c9ee, 0x41041f0f, 0x404779a4, 0x5d886e17, + 0x325f51eb, 0xd59bc0d1, 0xf2bcc18f, 0x41113564, 0x257b7834, 0x602a9c60, + 0xdff8e8a3, 0x1f636c1b, 0x0e12b4c2, 0x02e1329e, 0xaf664fd1, 0xcad18115, + 0x6b2395e0, 0x333e92e1, 0x3b240b62, 0xeebeb922, 0x85b2a20e, 0xe6ba0d99, + 0xde720c8c, 0x2da2f728, 0xd0127845, 0x95b794fd, 0x647d0862, 0xe7ccf5f0, + 0x5449a36f, 0x877d48fa, 0xc39dfd27, 0xf33e8d1e, 0x0a476341, 0x992eff74, + 0x3a6f6eab, 0xf4f8fd37, 0xa812dc60, 0xa1ebddf8, 0x991be14c, 0xdb6e6b0d, + 0xc67b5510, 0x6d672c37, 0x2765d43b, 0xdcd0e804, 0xf1290dc7, 0xcc00ffa3, + 0xb5390f92, 0x690fed0b, 0x667b9ffb, 0xcedb7d9c, 0xa091cf0b, 0xd9155ea3, + 0xbb132f88, 0x515bad24, 0x7b9479bf, 0x763bd6eb, 0x37392eb3, 0xcc115979, + 0x8026e297, 0xf42e312d, 0x6842ada7, 0xc66a2b3b, 0x12754ccc, 0x782ef11c, + 0x6a124237, 0xb79251e7, 0x06a1bbe6, 0x4bfb6350, 0x1a6b1018, 0x11caedfa, + 0x3d25bdd8, 0xe2e1c3c9, 0x44421659, 0x0a121386, 0xd90cec6e, 0xd5abea2a, + 0x64af674e, 0xda86a85f, 0xbebfe988, 0x64e4c3fe, 0x9dbc8057, 0xf0f7c086, + 0x60787bf8, 0x6003604d, 0xd1fd8346, 0xf6381fb0, 0x7745ae04, 0xd736fccc, + 0x83426b33, 0xf01eab71, 0xb0804187, 0x3c005e5f, 0x77a057be, 0xbde8ae24, + 0x55464299, 0xbf582e61, 0x4e58f48f, 0xf2ddfda2, 0xf474ef38, 0x8789bdc2, + 0x5366f9c3, 0xc8b38e74, 0xb475f255, 0x46fcd9b9, 0x7aeb2661, 0x8b1ddf84, + 0x846a0e79, 0x915f95e2, 0x466e598e, 0x20b45770, 0x8cd55591, 0xc902de4c, + 0xb90bace1, 0xbb8205d0, 0x11a86248, 0x7574a99e, 0xb77f19b6, 0xe0a9dc09, + 0x662d09a1, 0xc4324633, 0xe85a1f02, 0x09f0be8c, 0x4a99a025, 0x1d6efe10, + 0x1ab93d1d, 0x0ba5a4df, 0xa186f20f, 0x2868f169, 0xdcb7da83, 0x573906fe, + 0xa1e2ce9b, 0x4fcd7f52, 0x50115e01, 0xa70683fa, 0xa002b5c4, 0x0de6d027, + 0x9af88c27, 0x773f8641, 0xc3604c06, 0x61a806b5, 0xf0177a28, 0xc0f586e0, + 0x006058aa, 0x30dc7d62, 0x11e69ed7, 0x2338ea63, 0x53c2dd94, 0xc2c21634, + 0xbbcbee56, 0x90bcb6de, 0xebfc7da1, 0xce591d76, 0x6f05e409, 0x4b7c0188, + 0x39720a3d, 0x7c927c24, 0x86e3725f, 0x724d9db9, 0x1ac15bb4, 0xd39eb8fc, + 0xed545578, 0x08fca5b5, 0xd83d7cd3, 0x4dad0fc4, 0x1e50ef5e, 0xb161e6f8, + 0xa28514d9, 0x6c51133c, 0x6fd5c7e7, 0x56e14ec4, 0x362abfce, 0xddc6c837, + 0xd79a3234, 0x92638212, 0x670efa8e, 0x406000e0]) + +iSbox3 :: Sbox +iSbox3 = array (0,255) (zip [0..255] + [0x3a39ce37, 0xd3faf5cf, 0xabc27737, 0x5ac52d1b, 0x5cb0679e, 0x4fa33742, + 0xd3822740, 0x99bc9bbe, 0xd5118e9d, 0xbf0f7315, 0xd62d1c7e, 0xc700c47b, + 0xb78c1b6b, 0x21a19045, 0xb26eb1be, 0x6a366eb4, 0x5748ab2f, 0xbc946e79, + 0xc6a376d2, 0x6549c2c8, 0x530ff8ee, 0x468dde7d, 0xd5730a1d, 0x4cd04dc6, + 0x2939bbdb, 0xa9ba4650, 0xac9526e8, 0xbe5ee304, 0xa1fad5f0, 0x6a2d519a, + 0x63ef8ce2, 0x9a86ee22, 0xc089c2b8, 0x43242ef6, 0xa51e03aa, 0x9cf2d0a4, + 0x83c061ba, 0x9be96a4d, 0x8fe51550, 0xba645bd6, 0x2826a2f9, 0xa73a3ae1, + 0x4ba99586, 0xef5562e9, 0xc72fefd3, 0xf752f7da, 0x3f046f69, 0x77fa0a59, + 0x80e4a915, 0x87b08601, 0x9b09e6ad, 0x3b3ee593, 0xe990fd5a, 0x9e34d797, + 0x2cf0b7d9, 0x022b8b51, 0x96d5ac3a, 0x017da67d, 0xd1cf3ed6, 0x7c7d2d28, + 0x1f9f25cf, 0xadf2b89b, 0x5ad6b472, 0x5a88f54c, 0xe029ac71, 0xe019a5e6, + 0x47b0acfd, 0xed93fa9b, 0xe8d3c48d, 0x283b57cc, 0xf8d56629, 0x79132e28, + 0x785f0191, 0xed756055, 0xf7960e44, 0xe3d35e8c, 0x15056dd4, 0x88f46dba, + 0x03a16125, 0x0564f0bd, 0xc3eb9e15, 0x3c9057a2, 0x97271aec, 0xa93a072a, + 0x1b3f6d9b, 0x1e6321f5, 0xf59c66fb, 0x26dcf319, 0x7533d928, 0xb155fdf5, + 0x03563482, 0x8aba3cbb, 0x28517711, 0xc20ad9f8, 0xabcc5167, 0xccad925f, + 0x4de81751, 0x3830dc8e, 0x379d5862, 0x9320f991, 0xea7a90c2, 0xfb3e7bce, + 0x5121ce64, 0x774fbe32, 0xa8b6e37e, 0xc3293d46, 0x48de5369, 0x6413e680, + 0xa2ae0810, 0xdd6db224, 0x69852dfd, 0x09072166, 0xb39a460a, 0x6445c0dd, + 0x586cdecf, 0x1c20c8ae, 0x5bbef7dd, 0x1b588d40, 0xccd2017f, 0x6bb4e3bb, + 0xdda26a7e, 0x3a59ff45, 0x3e350a44, 0xbcb4cdd5, 0x72eacea8, 0xfa6484bb, + 0x8d6612ae, 0xbf3c6f47, 0xd29be463, 0x542f5d9e, 0xaec2771b, 0xf64e6370, + 0x740e0d8d, 0xe75b1357, 0xf8721671, 0xaf537d5d, 0x4040cb08, 0x4eb4e2cc, + 0x34d2466a, 0x0115af84, 0xe1b00428, 0x95983a1d, 0x06b89fb4, 0xce6ea048, + 0x6f3f3b82, 0x3520ab82, 0x011a1d4b, 0x277227f8, 0x611560b1, 0xe7933fdc, + 0xbb3a792b, 0x344525bd, 0xa08839e1, 0x51ce794b, 0x2f32c9b7, 0xa01fbac9, + 0xe01cc87e, 0xbcc7d1f6, 0xcf0111c3, 0xa1e8aac7, 0x1a908749, 0xd44fbd9a, + 0xd0dadecb, 0xd50ada38, 0x0339c32a, 0xc6913667, 0x8df9317c, 0xe0b12b4f, + 0xf79e59b7, 0x43f5bb3a, 0xf2d519ff, 0x27d9459c, 0xbf97222c, 0x15e6fc2a, + 0x0f91fc71, 0x9b941525, 0xfae59361, 0xceb69ceb, 0xc2a86459, 0x12baa8d1, + 0xb6c1075e, 0xe3056a0c, 0x10d25065, 0xcb03a442, 0xe0ec6e0e, 0x1698db3b, + 0x4c98a0be, 0x3278e964, 0x9f1f9532, 0xe0d392df, 0xd3a0342b, 0x8971f21e, + 0x1b0a7441, 0x4ba3348c, 0xc5be7120, 0xc37632d8, 0xdf359f8d, 0x9b992f2e, + 0xe60b6f47, 0x0fe3f11d, 0xe54cda54, 0x1edad891, 0xce6279cf, 0xcd3e7e6f, + 0x1618b166, 0xfd2c1d05, 0x848fd2c5, 0xf6fb2299, 0xf523f357, 0xa6327623, + 0x93a83531, 0x56cccd02, 0xacf08162, 0x5a75ebb5, 0x6e163697, 0x88d273cc, + 0xde966292, 0x81b949d0, 0x4c50901b, 0x71c65614, 0xe6c6c7bd, 0x327a140a, + 0x45e1d006, 0xc3f27b9a, 0xc9aa53fd, 0x62a80f00, 0xbb25bfe2, 0x35bdd2f6, + 0x71126905, 0xb2040222, 0xb6cbcf7c, 0xcd769c2b, 0x53113ec0, 0x1640e3d3, + 0x38abbd60, 0x2547adf0, 0xba38209c, 0xf746ce76, 0x77afa1c5, 0x20756060, + 0x85cbfe4e, 0x8ae88dd8, 0x7aaaf9b0, 0x4cf9aa7e, 0x1948c25c, 0x02fb8a8c, + 0x01c36ae4, 0xd6ebe1f9, 0x90d4f869, 0xa65cdea0, 0x3f09252d, 0xc208e69f, + 0xb74e6132, 0xce77e25b, 0x578fdfe3, 0x3ac372e6]) ===================================== testsuite/tests/codeGen/should_compile/all.T ===================================== @@ -127,3 +127,4 @@ test('T21710a', [ unless(tables_next_to_code(), skip) , when(wordsize(32), skip) , only_ways(['optasm']) , grep_errmsg('(call)',[1]) ] , compile, ['-ddump-cmm -dno-typeable-binds']) +test('T23002', normal, compile, ['-fregs-graph']) ===================================== testsuite/tests/ffi/should_compile/T22774.hs ===================================== @@ -0,0 +1,4 @@ +module T22774 where + +foreign import javascript foo :: IO () + ===================================== testsuite/tests/ffi/should_compile/all.T ===================================== @@ -44,3 +44,6 @@ test( ) test('T15531', normal, compile, ['-Wall']) test('T22043', [omit_ways(['ghci'])], compile, ['']) + +test('T22774', when(not js_arch(), expect_fail), compile, ['']) + ===================================== testsuite/tests/gadt/T23022.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module B where + +type data T a b where + MkT :: T a a + +f :: T a b -> T a b +f x = x ===================================== testsuite/tests/gadt/T23023.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeData, MagicHash #-} +module B where + +import GHC.Exts + +type data T a b where + MkT :: T a a + +f :: T Int Bool -> Char +f x = case dataToTag# x of + 0# -> 'a' + _ -> 'b' ===================================== testsuite/tests/gadt/all.T ===================================== @@ -129,3 +129,5 @@ test('T22235', normal, compile, ['']) test('T19847', normal, compile, ['']) test('T19847a', normal, compile, ['-ddump-types']) test('T19847b', normal, compile, ['']) +test('T23022', normal, compile, ['-dcore-lint']) +test('T23023', normal, compile, ['-dcore-lint']) ===================================== testsuite/tests/numeric/should_compile/T23019.hs ===================================== @@ -0,0 +1,21 @@ +module T23019 + ( + eexponent + ) where + +-- spine lazy, value strict list of doubles +data List + = Nil + | {-# UNPACK #-} !Double :! List + +infixr 5 :! + +newtype TowerDouble = Tower { getTower :: List } + +primal :: TowerDouble -> Double +primal (Tower (x:!_)) = x +primal _ = 0 + +eexponent :: TowerDouble -> Int +eexponent = exponent . primal + ===================================== testsuite/tests/numeric/should_compile/all.T ===================================== @@ -19,3 +19,4 @@ test('T20347', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-b test('T20448', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T19641', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T15547', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) +test('T23019', normal, compile, ['-O']) ===================================== testsuite/tests/simplCore/should_compile/T23026.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} + +module T23026 where + +import Data.Kind (Type) + +data Sing (a :: k) +data SingInstance (a :: k) = SingInstance (Sing a) + +app :: (Sing a -> SingInstance a) -> Sing a -> SingInstance a +app f x = f x +{-# NOINLINE app #-} + +withSomeSing + :: forall k2 k1 (f :: k2 -> k1 -> Type) a2 a1. + (Sing a2, Sing a1) + -> f a2 a1 + -> (forall b2 b1. f b2 b1 -> Int) + -> Int +withSomeSing (sa2, sa1) x g = + case app SingInstance sa2 of + SingInstance _ -> + case app SingInstance sa1 of + SingInstance _ -> g x +{-# INLINABLE withSomeSing #-} ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -476,3 +476,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) +test('T23026', normal, compile, ['-O']) ===================================== testsuite/tests/typecheck/should_fail/T22707.hs ===================================== @@ -0,0 +1,22 @@ +module T22707 where + +newtype Cont o i a = Cont {runCont ::(a -> i) -> o } + +t1:: Cont (i2 -> o) i1 a -> Cont o i2 (a -> i1) +t1 c = Cont $ \ati1tti2 -> (runCont c) (ati1tti2 $ \a -> evalCont (t1 c) >>== \ati1 -> return ati1 a ) + +evalCont:: Cont o a a -> o +evalCont c = (runCont c)id + +instance Monad (Cont p p) where + return a = Cont ($ a) + (>>=) = (>>==) + +class PMonad m where + (>>==):: m p q a -> (a -> m q r b) -> m p r b + +instance PMonad Cont where + (Cont cont) >>== afmb = Cont $ \bti -> cont $ \a -> (runCont . afmb) a bti + +main:: IO () +main = putStrLn "bug" ===================================== testsuite/tests/typecheck/should_fail/T22707.stderr ===================================== @@ -0,0 +1,16 @@ + +T22707.hs:6:37: error: [GHC-18872] + • Couldn't match kind ‘*’ with ‘GHC.Types.RuntimeRep’ + When matching types + p0 :: * + GHC.Types.LiftedRep :: GHC.Types.RuntimeRep + Expected: Cont o i1 a + Actual: Cont (i2 -> o) i1 a + • In the first argument of ‘runCont’, namely ‘c’ + In the expression: + (runCont c) + (ati1tti2 $ \ a -> evalCont (t1 c) >>== \ ati1 -> return ati1 a) + In the second argument of ‘($)’, namely + ‘\ ati1tti2 + -> (runCont c) + (ati1tti2 $ \ a -> evalCont (t1 c) >>== \ ati1 -> ...)’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -321,6 +321,7 @@ test('T7856', normal, compile_fail, ['']) test('T7869', normal, compile_fail, ['']) test('T7892', normal, compile_fail, ['']) test('T7809', normal, compile_fail, ['']) +test('T22707', normal, compile_fail, ['']) test('T7989', normal, compile_fail, ['']) test('T8034', normal, compile_fail, ['']) test('T8142', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7fefa808006f6fdb4744bde81f6ddb2fc27d6178...53c4b80add408db9f305b61a5fe3abe23b0a55e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7fefa808006f6fdb4744bde81f6ddb2fc27d6178...53c4b80add408db9f305b61a5fe3abe23b0a55e1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 08:20:21 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 03 Mar 2023 03:20:21 -0500 Subject: [Git][ghc/ghc][wip/t22707] 24 commits: Don't specialise incoherent instance applications Message-ID: <6401adc5a9f7b_3ab52b127ff3343821a2@gitlab.mail> Simon Peyton Jones pushed to branch wip/t22707 at Glasgow Haskell Compiler / GHC Commits: b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - e4c03dc2 by Simon Peyton Jones at 2023-03-03T08:21:22+00:00 Add test for T22793 - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Binds.hs-boot - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Interact.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f65f8bf85230f474569d3d611b1b26d87cf020df...e4c03dc2ac368030debdf6e6e516f6315bb8e362 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f65f8bf85230f474569d3d611b1b26d87cf020df...e4c03dc2ac368030debdf6e6e516f6315bb8e362 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 10:49:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Mar 2023 05:49:58 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: Don't suppress *all* Wanteds Message-ID: <6401d0d6c074b_3ab52b14bd07cc3982f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - c445364e by David Feuer at 2023-03-03T05:49:53-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 748bc2fb by David Feuer at 2023-03-03T05:49:53-05:00 Document getSolo - - - - - 852db97c by Simon Peyton Jones at 2023-03-03T05:49:53-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 30 changed files: - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Types/Constraint.hs - docs/users_guide/9.8.1-notes.rst - libraries/base/Data/Tuple.hs - libraries/base/changelog.md - libraries/ghc-prim/GHC/Tuple/Prim.hs - rts/Capability.c - rts/Capability.h - rts/RtsUtils.c - rts/RtsUtils.h - + testsuite/tests/codeGen/should_compile/T23002.hs - testsuite/tests/codeGen/should_compile/all.T - + testsuite/tests/ffi/should_compile/T22774.hs - testsuite/tests/ffi/should_compile/all.T - + testsuite/tests/gadt/T23022.hs - + testsuite/tests/gadt/T23023.hs - testsuite/tests/gadt/all.T - + testsuite/tests/numeric/should_compile/T23019.hs - testsuite/tests/numeric/should_compile/all.T - + testsuite/tests/simplCore/should_compile/T23026.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc9615a4a4d45baca244604fed6236ee0b645aad...852db97cec99041c07bdbf047920124057f10d5d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc9615a4a4d45baca244604fed6236ee0b645aad...852db97cec99041c07bdbf047920124057f10d5d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 11:19:59 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 03 Mar 2023 06:19:59 -0500 Subject: [Git][ghc/ghc][wip/t22707] Add test for T22793 Message-ID: <6401d7df7fbf4_3ab52b153402504059d1@gitlab.mail> Simon Peyton Jones pushed to branch wip/t22707 at Glasgow Haskell Compiler / GHC Commits: 6ba4a2dd by Simon Peyton Jones at 2023-03-03T11:20:51+00:00 Add test for T22793 - - - - - 3 changed files: - + testsuite/tests/polykinds/T22793.hs - + testsuite/tests/polykinds/T22793.stderr - testsuite/tests/polykinds/all.T Changes: ===================================== testsuite/tests/polykinds/T22793.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module T22793 where + +import Data.Kind + +type Foo :: forall k. k -> k -> Constraint + +class Foo s a + +bob :: forall {k1} {ks} {ka} q (p :: k1 -> q -> Type) + (f :: ka -> q) (s :: ks) (t :: ks) + (a :: ka) (b :: ka). Foo s a + => p a (f b) -> p s (f t) +bob f = undefined ===================================== testsuite/tests/polykinds/T22793.stderr ===================================== @@ -0,0 +1,44 @@ + +T22793.hs:15:42: error: [GHC-25897] + • Couldn't match kind ‘ka’ with ‘k1’ + Expected kind ‘ks’, but ‘a’ has kind ‘ka’ + ‘ka’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:26-27 + ‘k1’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:16-17 + • In the second argument of ‘Foo’, namely ‘a’ + In the type signature: + bob :: forall {k1} + {ks} + {ka} + q + (p :: k1 -> q -> Type) + (f :: ka -> q) + (s :: ks) + (t :: ks) + (a :: ka) + (b :: ka). Foo s a => p a (f b) -> p s (f t) + +T22793.hs:16:11: error: [GHC-25897] + • Couldn't match kind ‘ks’ with ‘k1’ + Expected kind ‘k1’, but ‘a’ has kind ‘ka’ + ‘ks’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:21-22 + ‘k1’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:16-17 + • In the first argument of ‘p’, namely ‘a’ + In the type signature: + bob :: forall {k1} + {ks} + {ka} + q + (p :: k1 -> q -> Type) + (f :: ka -> q) + (s :: ks) + (t :: ks) + (a :: ka) + (b :: ka). Foo s a => p a (f b) -> p s (f t) ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -243,3 +243,4 @@ test('T22379a', normal, compile, ['']) test('T22379b', normal, compile, ['']) test('T22743', normal, compile_fail, ['']) test('T22742', normal, compile_fail, ['']) +test('T22793', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ba4a2dda4abf17d36b55cd7625bbfa160a5b1f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ba4a2dda4abf17d36b55cd7625bbfa160a5b1f9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 11:26:35 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Fri, 03 Mar 2023 06:26:35 -0500 Subject: [Git][ghc/ghc][wip/or-pats] 65 commits: Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching Message-ID: <6401d96b5f03_3ab52b158bf730407721@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 11de7470 by David Knothe at 2023-03-03T12:25:45+01:00 Implement Or Patterns (Proposal 0522) This commit introduces a language extension, `OrPatterns`, as described in proposal 0522. It extends the syntax by the production `pat -> (one of pat1, ..., patk)`. The or-pattern `pat` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. Currently, or-patterns cannot bind variables. They are still of great use as they discourage the use of wildcard patterns in favour of writing out all "default" cases explicitly: ``` isIrrefutableHsPat pat = case pat of ... (one of WildPat{}, VarPat{}, LazyPat{}) = True (one of PArrPat{}, ConPatIn{}, LitPat{}, NPat{}, NPlusKPat{}, ListPat{}) = False ``` This makes code safer where data types are extended now and then - just like GHC's `Pat` in the example when adding the new `OrPat` constructor. This would be catched by `-fwarn-incomplete-patterns`, but not when a wildcard pattern was used. - Update submodule haddock. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/test-metrics.sh - CODEOWNERS - cabal.project-reinstall - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/RoughMap.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47c6ca3f753d3c1a06086d3d1ebc7a71324efd92...11de7470c891b19963f16e47b3e2ff70e727acdb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47c6ca3f753d3c1a06086d3d1ebc7a71324efd92...11de7470c891b19963f16e47b3e2ff70e727acdb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 12:11:00 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Fri, 03 Mar 2023 07:11:00 -0500 Subject: [Git][ghc/ghc][wip/or-pats] Implement Or Patterns (Proposal 0522) Message-ID: <6401e3d4c3418_3ab52b161a2adc410530@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 4c070b08 by David Knothe at 2023-03-03T13:10:28+01:00 Implement Or Patterns (Proposal 0522) This commit introduces a language extension, `OrPatterns`, as described in proposal 0522. It extends the syntax by the production `pat -> (one of pat1, ..., patk)`. The or-pattern `pat` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. Currently, or-patterns cannot bind variables. They are still of great use as they discourage the use of wildcard patterns in favour of writing out all "default" cases explicitly: ``` isIrrefutableHsPat pat = case pat of ... (one of WildPat{}, VarPat{}, LazyPat{}) = True (one of PArrPat{}, ConPatIn{}, LitPat{}, NPat{}, NPlusKPat{}, ListPat{}) = False ``` This makes code safer where data types are extended now and then - just like GHC's `Pat` in the example when adding the new `OrPat` constructor. This would be catched by `-fwarn-incomplete-patterns`, but not when a wildcard pattern was used. - Update submodule haddock. - - - - - 30 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Utils/Zonk.hs - compiler/GHC/Types/Error/Codes.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - + docs/users_guide/exts/or_patterns.rst - docs/users_guide/exts/patterns.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c070b086e8bc7c79117ee3764dc0ae13ba2fa95 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c070b086e8bc7c79117ee3764dc0ae13ba2fa95 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 13:50:44 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Mar 2023 08:50:44 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Export getSolo from Data.Tuple Message-ID: <6401fb3459658_3ab52b1797cb6c432842@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8f7c1da9 by David Feuer at 2023-03-03T08:50:35-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 5f75c07b by David Feuer at 2023-03-03T08:50:35-05:00 Document getSolo - - - - - 20d09ee2 by Simon Peyton Jones at 2023-03-03T08:50:35-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 14 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Gen/App.hs - docs/users_guide/9.8.1-notes.rst - libraries/base/Data/Tuple.hs - libraries/base/changelog.md - libraries/ghc-prim/GHC/Tuple/Prim.hs - + testsuite/tests/gadt/T23022.hs - + testsuite/tests/gadt/T23023.hs - testsuite/tests/gadt/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1669,13 +1669,25 @@ dataConOtherTheta dc = dcOtherTheta dc -- evidence, after any flattening has been done and without substituting for -- any type variables dataConRepArgTys :: DataCon -> [Scaled Type] -dataConRepArgTys (MkData { dcRep = rep - , dcEqSpec = eq_spec +dataConRepArgTys (MkData { dcRep = rep + , dcEqSpec = eq_spec , dcOtherTheta = theta - , dcOrigArgTys = orig_arg_tys }) + , dcOrigArgTys = orig_arg_tys + , dcRepTyCon = tc }) = case rep of - NoDataConRep -> assert (null eq_spec) $ map unrestricted theta ++ orig_arg_tys DCR { dcr_arg_tys = arg_tys } -> arg_tys + NoDataConRep + | isTypeDataTyCon tc -> assert (null theta) $ + orig_arg_tys + -- `type data` declarations can be GADTs (and hence have an eq_spec) + -- but no wrapper. They cannot have a theta. + -- See Note [Type data declarations] in GHC.Rename.Module + -- You might wonder why we ever call dataConRepArgTys for `type data`; + -- I think it's because of the call in mkDataCon, which in turn feeds + -- into dcRepArity, which in turn is used in mkDataConWorkId. + -- c.f. #23022 + | otherwise -> assert (null eq_spec) $ + map unrestricted theta ++ orig_arg_tys -- | The string @package:module.name@ identifying a constructor, which is attached -- to its info table and used by the GHCi debugger and the heap profiler ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1021,6 +1021,9 @@ lintIdOcc var nargs ; checkDeadIdOcc var ; checkJoinOcc var nargs + ; case isDataConId_maybe var of + Nothing -> return () + Just dc -> checkTypeDataConOcc "expression" dc ; usage <- varCallSiteUsage var @@ -1107,6 +1110,13 @@ checkJoinOcc var n_args | otherwise = return () +checkTypeDataConOcc :: String -> DataCon -> LintM () +-- Check that the Id is not a data constructor of a `type data` declaration +-- Invariant (I1) of Note [Type data declarations] in GHC.Rename.Module +checkTypeDataConOcc what dc + = checkL (not (isTypeDataTyCon (dataConTyCon dc))) $ + (text "type data constructor found in a" <+> text what <> colon <+> ppr dc) + -- | This function checks that we are able to perform eta expansion for -- functions with no binding, in order to satisfy invariant I3 -- from Note [Representation polymorphism invariants] in GHC.Core. @@ -1561,10 +1571,11 @@ lintCoreAlt case_bndr scrut_ty _scrut_mult alt_ty alt@(Alt (DataAlt con) args rh = zeroUE <$ addErrL (mkNewTyDataConAltMsg scrut_ty alt) | Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty = addLoc (CaseAlt alt) $ do - { -- First instantiate the universally quantified - -- type variables of the data constructor - -- We've already check - lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + { checkTypeDataConOcc "pattern" con + ; lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + + -- Instantiate the universally quantified + -- type variables of the data constructor ; let { con_payload_ty = piResultTys (dataConRepType con) tycon_arg_tys ; binderMult (Named _) = ManyTy ; binderMult (Anon st _) = scaledMult st ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, tyConDataCons - , tyConFamilySize ) + , tyConFamilySize, isTypeDataTyCon ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey ) @@ -3184,6 +3184,8 @@ caseRules _ (App (App (Var f) (Type ty)) v) -- dataToTag x | Just DataToTagOp <- isPrimOpId_maybe f , Just (tc, _) <- tcSplitTyConApp_maybe ty , isAlgTyCon tc + , not (isTypeDataTyCon tc) -- See wrinkle (W2c) in GHC.Rename.Module + -- Note [Type data declarations] = Just (v, tx_con_dtt ty , \v -> App (App (Var f) (Type ty)) (Var v)) ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -845,7 +845,8 @@ There are two exceptions where we avoid refining a DEFAULT case: __DEFAULT -> () Namely, we do _not_ want to match on `A`, as it doesn't exist at the value - level! + level! See wrinkle (W2b) in Note [Type data declarations] in GHC.Rename.Module + Note [Combine identical alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -152,8 +152,8 @@ vanillaCompleteMatchTC tc = tc == tYPETyCon = Just [] | -- Similarly, treat `type data` declarations as empty data types on -- the term level, as `type data` data constructors only exist at - -- the type level (#22964). - -- See Note [Type data declarations] in GHC.Rename.Module. + -- the type level (#22964). See wrinkle (W2a) in + -- Note [Type data declarations] in GHC.Rename.Module. isTypeDataTyCon tc = Just [] | otherwise = tyConDataCons_maybe tc in vanillaCompleteMatch . mkUniqDSet . map RealDataCon <$> mb_dcs ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2073,9 +2073,79 @@ preceded by `type`, with the following restrictions: (R5) There are no deriving clauses. +The data constructors of a `type data` declaration obey the following +Core invariant: + +(I1) The data constructors of a `type data` declaration may be mentioned in + /types/, but never in /terms/ or the /pattern of a case alternative/. + +Wrinkles: + +(W0) Wrappers. The data constructor of a `type data` declaration has a worker + (like every data constructor) but does /not/ have a wrapper. Wrappers + only make sense for value-level data constructors. Indeed, the worker Id + is never used (invariant (I1)), so it barely makes sense to talk about + the worker. A `type data` constructor only shows up in types, where it + appears as a TyCon, specifically a PromotedDataCon -- no Id in sight. + + See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where + this check is implemented. + + This specifically includes `type data` declarations implemented as GADTs, + such as this example from #22948: + + type data T a where + A :: T Int + B :: T a + + If `T` were an ordinary `data` declaration, then `A` would have a wrapper + to account for the GADT-like equality in its return type. Because `T` is + declared as a `type data` declaration, however, the wrapper is omitted. + +(W1) To prevent users from conjuring up `type data` values at the term level, + we disallow using the tagToEnum# function on a type headed by a `type + data` type. For instance, GHC will reject this code: + + type data Letter = A | B | C + + f :: Letter + f = tagToEnum# 0# + + See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. + +(W2) Although `type data` data constructors do not exist at the value level, + it is still possible to match on a value whose type is headed by a `type data` + type constructor, such as this example from #22964: + + type data T a where + A :: T Int + B :: T a + + f :: T a -> () + f x = case x of {} + + And yet we must guarantee invariant (I1). This has three consequences: + + (W2a) During checking the coverage of `f`'s pattern matches, we treat `T` + as if it were an empty data type so that GHC does not warn the user + to match against `A` or `B`. (Otherwise, you end up with the bug + reported in #22964.) See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. + + (W2b) In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case + with the data constructor, else (I1) is violated. See GHC.Core.Utils + Note [Refine DEFAULT case alternatives] Exception 2 + + (W2c) In `GHC.Core.Opt.ConstantFold.caseRules`, disable the rule for + `dataToTag#` in the case of `type data`. We do not want to transform + case dataToTag# x of t -> blah + into + case x of { A -> ...; B -> .. } + because again that conjures up the type-level-only data contructors + `A` and `B` in a pattern, violating (I1) (#23023). + The main parts of the implementation are: -* (R0): The parser recognizes `type data` (but not `type newtype`). +* The parser recognizes `type data` (but not `type newtype`); this ensures (R0). * During the initial construction of the AST, GHC.Parser.PostProcess.checkNewOrData sets the `Bool` argument of the @@ -2134,54 +2204,6 @@ The main parts of the implementation are: `type data` declarations. When these are converted back to Hs types in a splice, the constructors are placed in the TcCls namespace. -* A `type data` declaration _never_ generates wrappers for its data - constructors, as they only make sense for value-level data constructors. - See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where - this check is implemented. - - This includes `type data` declarations implemented as GADTs, such as - this example from #22948: - - type data T a where - A :: T Int - B :: T a - - If `T` were an ordinary `data` declaration, then `A` would have a wrapper - to account for the GADT-like equality in its return type. Because `T` is - declared as a `type data` declaration, however, the wrapper is omitted. - -* Although `type data` data constructors do not exist at the value level, - it is still possible to match on a value whose type is headed by a `type data` - type constructor, such as this example from #22964: - - type data T a where - A :: T Int - B :: T a - - f :: T a -> () - f x = case x of {} - - This has two consequences: - - * During checking the coverage of `f`'s pattern matches, we treat `T` as if it - were an empty data type so that GHC does not warn the user to match against - `A` or `B`. (Otherwise, you end up with the bug reported in #22964.) - See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. - - * In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case with - the data constructor. See - Note [Refine DEFAULT case alternatives] Exception 2, in GHC.Core.Utils. - -* To prevent users from conjuring up `type data` values at the term level, we - disallow using the tagToEnum# function on a type headed by a `type data` - type. For instance, GHC will reject this code: - - type data Letter = A | B | C - - f :: Letter - f = tagToEnum# 0# - - See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -1222,7 +1222,8 @@ tcTagToEnum tc_fun fun_ctxt tc_args res_ty vanilla_result = rebuildHsApps tc_fun fun_ctxt tc_args res_ty check_enumeration ty' tc - | -- isTypeDataTyCon: see Note [Type data declarations] in GHC.Rename.Module + | -- isTypeDataTyCon: see wrinkle (W1) in + -- Note [Type data declarations] in GHC.Rename.Module isTypeDataTyCon tc = addErrTc (TcRnTagToEnumResTyTypeData ty') | isEnumerationTyCon tc = return () | otherwise = addErrTc (TcRnTagToEnumResTyNotAnEnum ty') ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -46,6 +46,7 @@ Runtime system ``base`` library ~~~~~~~~~~~~~~~~ +- ``Data.Tuple`` now exports ``getSolo :: Solo a -> a``. ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/Data/Tuple.hs ===================================== @@ -17,6 +17,7 @@ module Data.Tuple ( Solo (..) + , getSolo , fst , snd , curry @@ -25,7 +26,7 @@ module Data.Tuple ) where import GHC.Base () -- Note [Depend on GHC.Tuple] -import GHC.Tuple (Solo (..)) +import GHC.Tuple (Solo (..), getSolo) default () -- Double isn't available yet ===================================== libraries/base/changelog.md ===================================== @@ -7,6 +7,8 @@ * Refactor `generalCategory` to stop very large literal string being inlined to call-sites. ([CLC proposal #130](https://github.com/haskell/core-libraries-committee/issues/130)) * Add INLINABLE pragmas to `generic*` functions in Data.OldList ([CLC proposal #129](https://github.com/haskell/core-libraries-committee/issues/130)) + * Export `getSolo` from `Data.Tuple`. + ([CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113)) ## 4.18.0.0 *TBA* ===================================== libraries/ghc-prim/GHC/Tuple/Prim.hs ===================================== @@ -79,6 +79,26 @@ data () = () -- implementations of lazy and strict mapping functions. data Solo a = MkSolo a +-- | Extract the value from a 'Solo'. Very often, values should be extracted +-- directly using pattern matching, to control just what gets evaluated when. +-- @getSolo@ is for convenience in situations where that is not the case: +-- +-- When the result is passed to a /strict/ function, it makes no difference +-- whether the pattern matching is done on the \"outside\" or on the +-- \"inside\": +-- +-- @ +-- Data.Set.insert (getSolo sol) set === case sol of Solo v -> Data.Set.insert v set +-- @ +-- +-- A traversal may be performed in 'Solo' in order to control evaluation +-- internally, while using @getSolo@ to extract the final result. A strict +-- mapping function, for example, could be defined +-- +-- @ +-- map' :: Traversable t => (a -> b) -> t a -> t b +-- map' f = getSolo . traverse ((Solo $!) . f) +-- @ getSolo :: Solo a -> a -- getSolo is a standalone function, rather than a record field of Solo, -- because Solo is a wired-in TyCon, and a wired-in TyCon that has ===================================== testsuite/tests/gadt/T23022.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module B where + +type data T a b where + MkT :: T a a + +f :: T a b -> T a b +f x = x ===================================== testsuite/tests/gadt/T23023.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeData, MagicHash #-} +module B where + +import GHC.Exts + +type data T a b where + MkT :: T a a + +f :: T Int Bool -> Char +f x = case dataToTag# x of + 0# -> 'a' + _ -> 'b' ===================================== testsuite/tests/gadt/all.T ===================================== @@ -129,3 +129,5 @@ test('T22235', normal, compile, ['']) test('T19847', normal, compile, ['']) test('T19847a', normal, compile, ['-ddump-types']) test('T19847b', normal, compile, ['']) +test('T23022', normal, compile, ['-dcore-lint']) +test('T23023', normal, compile, ['-dcore-lint']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/852db97cec99041c07bdbf047920124057f10d5d...20d09ee2373cc340e76edfd01c31220864d778c6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/852db97cec99041c07bdbf047920124057f10d5d...20d09ee2373cc340e76edfd01c31220864d778c6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 14:18:11 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 03 Mar 2023 09:18:11 -0500 Subject: [Git][ghc/ghc][wip/js-th] JS: implement TH support Message-ID: <640201a38c96_3ab52b18363c7043891e@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: a6860195 by Sylvain Henry at 2023-03-03T15:22:50+01:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Runtime/Interpreter.hs - + compiler/GHC/Runtime/Interpreter/JS.hs - + compiler/GHC/Runtime/Interpreter/Process.hs - compiler/GHC/Runtime/Interpreter/Types.hs - + compiler/GHC/Runtime/Utils.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Types.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/ghc.cabal.in - + ghc-interp.js - hadrian/src/Base.hs - hadrian/src/Rules/Generate.hs - libraries/base/System/Posix/Internals.hs - libraries/base/jsbits/base.js - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/RemoteTypes.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - libraries/template-haskell/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/annotations/should_compile/all.T - testsuite/tests/annotations/should_fail/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a68601954b75447a6856fe6e6918232633d2b56e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a68601954b75447a6856fe6e6918232633d2b56e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 14:46:40 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 03 Mar 2023 09:46:40 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/backports-9.6 Message-ID: <64020850851c3_3ab52b18ab38b844274b@gitlab.mail> Ben Gamari deleted branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 14:46:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 03 Mar 2023 09:46:45 -0500 Subject: [Git][ghc/ghc][ghc-9.6] 14 commits: Refine the test for naughty record selectors Message-ID: <64020855255a5_3ab52b18ab38a4442989@gitlab.mail> Ben Gamari pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC Commits: c00a8a78 by Simon Peyton Jones at 2023-03-02T10:15:53-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. (cherry picked from commit cf118e2fac04b79cc7fa63cff0552190c3885bb9) - - - - - 3b9bf327 by Simon Peyton Jones at 2023-03-02T10:16:05-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. (cherry picked from commit bb500e2a2d039dc75c8bb80d47ea2349b97fbf1b) - - - - - 0105758b by Sebastian Graf at 2023-03-02T10:16:14-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 (cherry picked from commit a2a1a1c08bb520b74b00194a83add82b287b38d5) - - - - - 8f1ba948 by Cheng Shao at 2023-03-02T10:16:21-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. (cherry picked from commit 9fa545722f9151781344446dd5501db38cb90dd1) - - - - - b821cdbd by Sylvain Henry at 2023-03-02T10:16:55-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. (cherry picked from commit 8b77f9bfceb456115f63349ad0ff66a5cea7ab59) - - - - - 20dfcbed by Simon Peyton Jones at 2023-03-02T10:18:26-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules (cherry picked from commit 0c200ab78c814cb5d1efaf426f0d3d91ceab9f4d) - - - - - 5451b48c by Simon Peyton Jones at 2023-03-02T10:21:25-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. (cherry picked from commit ece092d07f343dcfb4563e4f42d53a2a1e449f1a) - - - - - b73b70bf by Simon Peyton Jones at 2023-03-02T10:31:49-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 (cherry picked from commit 7192ef91c855e1fae6997f75cfde76aafd0b4bcf) - - - - - 0a0e22f5 by Ben Gamari at 2023-03-02T10:33:54-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. (cherry picked from commit 485ccddacff5ed8892348905754c02452ac8f523) - - - - - 72087b1d by Ben Gamari at 2023-03-02T12:31:12-05:00 rts: Introduce stgMallocAlignedBytes (cherry picked from commit eeb5bd560942a4968980fb341d9ebca33ad3302b) - - - - - ac7bbf64 by Ben Gamari at 2023-03-02T12:31:12-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. (cherry picked from commit 2cca72cd3e4de25fa81dc6fcc9979e613697a838) - - - - - 4bda8c6c by Ben Gamari at 2023-03-02T12:31:12-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. (cherry picked from commit 05c5b14c5e28c279de0d84472526eccb7f05d00a) - - - - - cbdc5d51 by Ben Gamari at 2023-03-02T12:31:12-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. (cherry picked from commit 8bed166bb79445f90015757fd5baac69a7b835df) - - - - - fbc98e66 by Ben Gamari at 2023-03-02T12:31:12-05:00 docs/relnotes: Mention -fprefer-byte-code Closes #23027. - - - - - 30 changed files: - compiler/GHC/CmmToAsm.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/TyCl/Utils.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/using-optimisation.rst - libraries/base/GHC/List.hs - libraries/ghc-prim/cbits/atomic.c - rts/Capability.c - rts/Capability.h - rts/RtsUtils.c - rts/RtsUtils.h - rts/include/stg/Prim.h - rts/js/mem.js - testsuite/tests/codeGen/should_run/CopySmallArray.hs - testsuite/tests/codeGen/should_run/CopySmallArray.stdout - testsuite/tests/codeGen/should_run/cgrun070.hs - testsuite/tests/codeGen/should_run/cgrun070.stdout - + testsuite/tests/patsyn/should_compile/T23038.hs - + testsuite/tests/patsyn/should_compile/T23038.stderr - testsuite/tests/patsyn/should_compile/all.T - testsuite/tests/perf/should_run/T18964.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/feccc865db4645d02c6326cb9363df8441525950...fbc98e66077b933b634bf86a8d4a739ef10ea232 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/feccc865db4645d02c6326cb9363df8441525950...fbc98e66077b933b634bf86a8d4a739ef10ea232 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 14:47:08 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 03 Mar 2023 09:47:08 -0500 Subject: [Git][ghc/ghc] Pushed new tag ghc-9.6.1-rc1 Message-ID: <6402086c22481_3ab52b18ab38904431b6@gitlab.mail> Ben Gamari pushed new tag ghc-9.6.1-rc1 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.6.1-rc1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 15:41:16 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 03 Mar 2023 10:41:16 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22886 Message-ID: <6402151c51264_3ab52b19dcf834486132@gitlab.mail> Simon Peyton Jones pushed new branch wip/T22886 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22886 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 16:32:28 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Fri, 03 Mar 2023 11:32:28 -0500 Subject: [Git][ghc/ghc][wip/js-th] JS: implement TH support Message-ID: <6402211c7af28_3ab52b1b0e20c05162be@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 353c6e4c by Sylvain Henry at 2023-03-03T17:37:09+01:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Runtime/Interpreter.hs - + compiler/GHC/Runtime/Interpreter/JS.hs - + compiler/GHC/Runtime/Interpreter/Process.hs - compiler/GHC/Runtime/Interpreter/Types.hs - + compiler/GHC/Runtime/Utils.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Types.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/ghc.cabal.in - + ghc-interp.js - hadrian/src/Base.hs - hadrian/src/Rules/Generate.hs - libraries/base/System/Posix/Internals.hs - libraries/base/jsbits/base.js - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/RemoteTypes.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - libraries/template-haskell/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/annotations/should_compile/all.T - testsuite/tests/annotations/should_fail/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/353c6e4c58189c5e06739b3bc2a6d2bb7c9722cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/353c6e4c58189c5e06739b3bc2a6d2bb7c9722cd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 16:41:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Mar 2023 11:41:04 -0500 Subject: [Git][ghc/ghc][master] 2 commits: Export getSolo from Data.Tuple Message-ID: <64022320e753d_3ab52b1b37cec05253ee@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - 4 changed files: - docs/users_guide/9.8.1-notes.rst - libraries/base/Data/Tuple.hs - libraries/base/changelog.md - libraries/ghc-prim/GHC/Tuple/Prim.hs Changes: ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -46,6 +46,7 @@ Runtime system ``base`` library ~~~~~~~~~~~~~~~~ +- ``Data.Tuple`` now exports ``getSolo :: Solo a -> a``. ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/Data/Tuple.hs ===================================== @@ -17,6 +17,7 @@ module Data.Tuple ( Solo (..) + , getSolo , fst , snd , curry @@ -25,7 +26,7 @@ module Data.Tuple ) where import GHC.Base () -- Note [Depend on GHC.Tuple] -import GHC.Tuple (Solo (..)) +import GHC.Tuple (Solo (..), getSolo) default () -- Double isn't available yet ===================================== libraries/base/changelog.md ===================================== @@ -7,6 +7,8 @@ * Refactor `generalCategory` to stop very large literal string being inlined to call-sites. ([CLC proposal #130](https://github.com/haskell/core-libraries-committee/issues/130)) * Add INLINABLE pragmas to `generic*` functions in Data.OldList ([CLC proposal #129](https://github.com/haskell/core-libraries-committee/issues/130)) + * Export `getSolo` from `Data.Tuple`. + ([CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113)) ## 4.18.0.0 *TBA* ===================================== libraries/ghc-prim/GHC/Tuple/Prim.hs ===================================== @@ -79,6 +79,26 @@ data () = () -- implementations of lazy and strict mapping functions. data Solo a = MkSolo a +-- | Extract the value from a 'Solo'. Very often, values should be extracted +-- directly using pattern matching, to control just what gets evaluated when. +-- @getSolo@ is for convenience in situations where that is not the case: +-- +-- When the result is passed to a /strict/ function, it makes no difference +-- whether the pattern matching is done on the \"outside\" or on the +-- \"inside\": +-- +-- @ +-- Data.Set.insert (getSolo sol) set === case sol of Solo v -> Data.Set.insert v set +-- @ +-- +-- A traversal may be performed in 'Solo' in order to control evaluation +-- internally, while using @getSolo@ to extract the final result. A strict +-- mapping function, for example, could be defined +-- +-- @ +-- map' :: Traversable t => (a -> b) -> t a -> t b +-- map' f = getSolo . traverse ((Solo $!) . f) +-- @ getSolo :: Solo a -> a -- getSolo is a standalone function, rather than a record field of Solo, -- because Solo is a wired-in TyCon, and a wired-in TyCon that has View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2f97c86151d7eed115ddcbdee1842684aed63176...0c6948957f62d96a8234683fdf67b34369aad240 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2f97c86151d7eed115ddcbdee1842684aed63176...0c6948957f62d96a8234683fdf67b34369aad240 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 16:41:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Mar 2023 11:41:48 -0500 Subject: [Git][ghc/ghc][master] More fixes for `type data` declarations Message-ID: <6402234c3ab8c_3ab52b1b5250d85324ed@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 10 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Gen/App.hs - + testsuite/tests/gadt/T23022.hs - + testsuite/tests/gadt/T23023.hs - testsuite/tests/gadt/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1669,13 +1669,25 @@ dataConOtherTheta dc = dcOtherTheta dc -- evidence, after any flattening has been done and without substituting for -- any type variables dataConRepArgTys :: DataCon -> [Scaled Type] -dataConRepArgTys (MkData { dcRep = rep - , dcEqSpec = eq_spec +dataConRepArgTys (MkData { dcRep = rep + , dcEqSpec = eq_spec , dcOtherTheta = theta - , dcOrigArgTys = orig_arg_tys }) + , dcOrigArgTys = orig_arg_tys + , dcRepTyCon = tc }) = case rep of - NoDataConRep -> assert (null eq_spec) $ map unrestricted theta ++ orig_arg_tys DCR { dcr_arg_tys = arg_tys } -> arg_tys + NoDataConRep + | isTypeDataTyCon tc -> assert (null theta) $ + orig_arg_tys + -- `type data` declarations can be GADTs (and hence have an eq_spec) + -- but no wrapper. They cannot have a theta. + -- See Note [Type data declarations] in GHC.Rename.Module + -- You might wonder why we ever call dataConRepArgTys for `type data`; + -- I think it's because of the call in mkDataCon, which in turn feeds + -- into dcRepArity, which in turn is used in mkDataConWorkId. + -- c.f. #23022 + | otherwise -> assert (null eq_spec) $ + map unrestricted theta ++ orig_arg_tys -- | The string @package:module.name@ identifying a constructor, which is attached -- to its info table and used by the GHCi debugger and the heap profiler ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1021,6 +1021,9 @@ lintIdOcc var nargs ; checkDeadIdOcc var ; checkJoinOcc var nargs + ; case isDataConId_maybe var of + Nothing -> return () + Just dc -> checkTypeDataConOcc "expression" dc ; usage <- varCallSiteUsage var @@ -1107,6 +1110,13 @@ checkJoinOcc var n_args | otherwise = return () +checkTypeDataConOcc :: String -> DataCon -> LintM () +-- Check that the Id is not a data constructor of a `type data` declaration +-- Invariant (I1) of Note [Type data declarations] in GHC.Rename.Module +checkTypeDataConOcc what dc + = checkL (not (isTypeDataTyCon (dataConTyCon dc))) $ + (text "type data constructor found in a" <+> text what <> colon <+> ppr dc) + -- | This function checks that we are able to perform eta expansion for -- functions with no binding, in order to satisfy invariant I3 -- from Note [Representation polymorphism invariants] in GHC.Core. @@ -1561,10 +1571,11 @@ lintCoreAlt case_bndr scrut_ty _scrut_mult alt_ty alt@(Alt (DataAlt con) args rh = zeroUE <$ addErrL (mkNewTyDataConAltMsg scrut_ty alt) | Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty = addLoc (CaseAlt alt) $ do - { -- First instantiate the universally quantified - -- type variables of the data constructor - -- We've already check - lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + { checkTypeDataConOcc "pattern" con + ; lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + + -- Instantiate the universally quantified + -- type variables of the data constructor ; let { con_payload_ty = piResultTys (dataConRepType con) tycon_arg_tys ; binderMult (Named _) = ManyTy ; binderMult (Anon st _) = scaledMult st ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, tyConDataCons - , tyConFamilySize ) + , tyConFamilySize, isTypeDataTyCon ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey ) @@ -3184,6 +3184,8 @@ caseRules _ (App (App (Var f) (Type ty)) v) -- dataToTag x | Just DataToTagOp <- isPrimOpId_maybe f , Just (tc, _) <- tcSplitTyConApp_maybe ty , isAlgTyCon tc + , not (isTypeDataTyCon tc) -- See wrinkle (W2c) in GHC.Rename.Module + -- Note [Type data declarations] = Just (v, tx_con_dtt ty , \v -> App (App (Var f) (Type ty)) (Var v)) ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -845,7 +845,8 @@ There are two exceptions where we avoid refining a DEFAULT case: __DEFAULT -> () Namely, we do _not_ want to match on `A`, as it doesn't exist at the value - level! + level! See wrinkle (W2b) in Note [Type data declarations] in GHC.Rename.Module + Note [Combine identical alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -152,8 +152,8 @@ vanillaCompleteMatchTC tc = tc == tYPETyCon = Just [] | -- Similarly, treat `type data` declarations as empty data types on -- the term level, as `type data` data constructors only exist at - -- the type level (#22964). - -- See Note [Type data declarations] in GHC.Rename.Module. + -- the type level (#22964). See wrinkle (W2a) in + -- Note [Type data declarations] in GHC.Rename.Module. isTypeDataTyCon tc = Just [] | otherwise = tyConDataCons_maybe tc in vanillaCompleteMatch . mkUniqDSet . map RealDataCon <$> mb_dcs ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2073,9 +2073,79 @@ preceded by `type`, with the following restrictions: (R5) There are no deriving clauses. +The data constructors of a `type data` declaration obey the following +Core invariant: + +(I1) The data constructors of a `type data` declaration may be mentioned in + /types/, but never in /terms/ or the /pattern of a case alternative/. + +Wrinkles: + +(W0) Wrappers. The data constructor of a `type data` declaration has a worker + (like every data constructor) but does /not/ have a wrapper. Wrappers + only make sense for value-level data constructors. Indeed, the worker Id + is never used (invariant (I1)), so it barely makes sense to talk about + the worker. A `type data` constructor only shows up in types, where it + appears as a TyCon, specifically a PromotedDataCon -- no Id in sight. + + See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where + this check is implemented. + + This specifically includes `type data` declarations implemented as GADTs, + such as this example from #22948: + + type data T a where + A :: T Int + B :: T a + + If `T` were an ordinary `data` declaration, then `A` would have a wrapper + to account for the GADT-like equality in its return type. Because `T` is + declared as a `type data` declaration, however, the wrapper is omitted. + +(W1) To prevent users from conjuring up `type data` values at the term level, + we disallow using the tagToEnum# function on a type headed by a `type + data` type. For instance, GHC will reject this code: + + type data Letter = A | B | C + + f :: Letter + f = tagToEnum# 0# + + See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. + +(W2) Although `type data` data constructors do not exist at the value level, + it is still possible to match on a value whose type is headed by a `type data` + type constructor, such as this example from #22964: + + type data T a where + A :: T Int + B :: T a + + f :: T a -> () + f x = case x of {} + + And yet we must guarantee invariant (I1). This has three consequences: + + (W2a) During checking the coverage of `f`'s pattern matches, we treat `T` + as if it were an empty data type so that GHC does not warn the user + to match against `A` or `B`. (Otherwise, you end up with the bug + reported in #22964.) See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. + + (W2b) In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case + with the data constructor, else (I1) is violated. See GHC.Core.Utils + Note [Refine DEFAULT case alternatives] Exception 2 + + (W2c) In `GHC.Core.Opt.ConstantFold.caseRules`, disable the rule for + `dataToTag#` in the case of `type data`. We do not want to transform + case dataToTag# x of t -> blah + into + case x of { A -> ...; B -> .. } + because again that conjures up the type-level-only data contructors + `A` and `B` in a pattern, violating (I1) (#23023). + The main parts of the implementation are: -* (R0): The parser recognizes `type data` (but not `type newtype`). +* The parser recognizes `type data` (but not `type newtype`); this ensures (R0). * During the initial construction of the AST, GHC.Parser.PostProcess.checkNewOrData sets the `Bool` argument of the @@ -2134,54 +2204,6 @@ The main parts of the implementation are: `type data` declarations. When these are converted back to Hs types in a splice, the constructors are placed in the TcCls namespace. -* A `type data` declaration _never_ generates wrappers for its data - constructors, as they only make sense for value-level data constructors. - See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where - this check is implemented. - - This includes `type data` declarations implemented as GADTs, such as - this example from #22948: - - type data T a where - A :: T Int - B :: T a - - If `T` were an ordinary `data` declaration, then `A` would have a wrapper - to account for the GADT-like equality in its return type. Because `T` is - declared as a `type data` declaration, however, the wrapper is omitted. - -* Although `type data` data constructors do not exist at the value level, - it is still possible to match on a value whose type is headed by a `type data` - type constructor, such as this example from #22964: - - type data T a where - A :: T Int - B :: T a - - f :: T a -> () - f x = case x of {} - - This has two consequences: - - * During checking the coverage of `f`'s pattern matches, we treat `T` as if it - were an empty data type so that GHC does not warn the user to match against - `A` or `B`. (Otherwise, you end up with the bug reported in #22964.) - See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. - - * In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case with - the data constructor. See - Note [Refine DEFAULT case alternatives] Exception 2, in GHC.Core.Utils. - -* To prevent users from conjuring up `type data` values at the term level, we - disallow using the tagToEnum# function on a type headed by a `type data` - type. For instance, GHC will reject this code: - - type data Letter = A | B | C - - f :: Letter - f = tagToEnum# 0# - - See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -1222,7 +1222,8 @@ tcTagToEnum tc_fun fun_ctxt tc_args res_ty vanilla_result = rebuildHsApps tc_fun fun_ctxt tc_args res_ty check_enumeration ty' tc - | -- isTypeDataTyCon: see Note [Type data declarations] in GHC.Rename.Module + | -- isTypeDataTyCon: see wrinkle (W1) in + -- Note [Type data declarations] in GHC.Rename.Module isTypeDataTyCon tc = addErrTc (TcRnTagToEnumResTyTypeData ty') | isEnumerationTyCon tc = return () | otherwise = addErrTc (TcRnTagToEnumResTyNotAnEnum ty') ===================================== testsuite/tests/gadt/T23022.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module B where + +type data T a b where + MkT :: T a a + +f :: T a b -> T a b +f x = x ===================================== testsuite/tests/gadt/T23023.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeData, MagicHash #-} +module B where + +import GHC.Exts + +type data T a b where + MkT :: T a a + +f :: T Int Bool -> Char +f x = case dataToTag# x of + 0# -> 'a' + _ -> 'b' ===================================== testsuite/tests/gadt/all.T ===================================== @@ -129,3 +129,5 @@ test('T22235', normal, compile, ['']) test('T19847', normal, compile, ['']) test('T19847a', normal, compile, ['-ddump-types']) test('T19847b', normal, compile, ['']) +test('T23022', normal, compile, ['-dcore-lint']) +test('T23023', normal, compile, ['-dcore-lint']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd0536afee5d5f91d99af2ab193b6eee5b1da07a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd0536afee5d5f91d99af2ab193b6eee5b1da07a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 3 19:46:45 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 03 Mar 2023 14:46:45 -0500 Subject: [Git][ghc/ghc][wip/T22886] Wibble Message-ID: <64024ea5115f3_3ab52b1ee5aed45499b4@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22886 at Glasgow Haskell Compiler / GHC Commits: dd742db0 by Simon Peyton Jones at 2023-03-03T19:47:49+00:00 Wibble - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1859,8 +1859,7 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpandRhs env bind_cxt bndr rhs - | pprTrace "tryeta" (ppr bndr $$ ppr do_eta_expand $$ ppr (seEtaExpand env) $$ ppr (wantEtaExpansion rhs)) $ - do_eta_expand -- If the current manifest arity isn't enough + | do_eta_expand -- If the current manifest arity isn't enough -- (never true for join points) , seEtaExpand env -- and eta-expansion is on , wantEtaExpansion rhs @@ -1894,8 +1893,7 @@ wantEtaExpansion e = go e [] go (Lam b e) [] | isTyVar b = go e [] | otherwise = True - go (Var f) args = pprTrace "wantEtaExpansion" (ppr f $$ ppr args $$ ppr (isInlineUnfolding (idUnfolding f)) $$ ppr (any interesting args)) $ - isInlineUnfolding (idUnfolding f) + go (Var f) args = isInlineUnfolding (idUnfolding f) && any interesting args go _ _ = True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd742db0e091bd9e9bd235b047a3e1cfb8c592d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd742db0e091bd9e9bd235b047a3e1cfb8c592d0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 4 00:05:50 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 03 Mar 2023 19:05:50 -0500 Subject: [Git][ghc/ghc][wip/t22707] 4 commits: Export getSolo from Data.Tuple Message-ID: <64028b5e4fc9a_3ab52b231250fc5780e@gitlab.mail> Simon Peyton Jones pushed to branch wip/t22707 at Glasgow Haskell Compiler / GHC Commits: 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - c7c1a73b by Simon Peyton Jones at 2023-03-04T00:05:43+00:00 Add test for T22793 - - - - - 17 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Gen/App.hs - docs/users_guide/9.8.1-notes.rst - libraries/base/Data/Tuple.hs - libraries/base/changelog.md - libraries/ghc-prim/GHC/Tuple/Prim.hs - + testsuite/tests/gadt/T23022.hs - + testsuite/tests/gadt/T23023.hs - testsuite/tests/gadt/all.T - + testsuite/tests/polykinds/T22793.hs - + testsuite/tests/polykinds/T22793.stderr - testsuite/tests/polykinds/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1669,13 +1669,25 @@ dataConOtherTheta dc = dcOtherTheta dc -- evidence, after any flattening has been done and without substituting for -- any type variables dataConRepArgTys :: DataCon -> [Scaled Type] -dataConRepArgTys (MkData { dcRep = rep - , dcEqSpec = eq_spec +dataConRepArgTys (MkData { dcRep = rep + , dcEqSpec = eq_spec , dcOtherTheta = theta - , dcOrigArgTys = orig_arg_tys }) + , dcOrigArgTys = orig_arg_tys + , dcRepTyCon = tc }) = case rep of - NoDataConRep -> assert (null eq_spec) $ map unrestricted theta ++ orig_arg_tys DCR { dcr_arg_tys = arg_tys } -> arg_tys + NoDataConRep + | isTypeDataTyCon tc -> assert (null theta) $ + orig_arg_tys + -- `type data` declarations can be GADTs (and hence have an eq_spec) + -- but no wrapper. They cannot have a theta. + -- See Note [Type data declarations] in GHC.Rename.Module + -- You might wonder why we ever call dataConRepArgTys for `type data`; + -- I think it's because of the call in mkDataCon, which in turn feeds + -- into dcRepArity, which in turn is used in mkDataConWorkId. + -- c.f. #23022 + | otherwise -> assert (null eq_spec) $ + map unrestricted theta ++ orig_arg_tys -- | The string @package:module.name@ identifying a constructor, which is attached -- to its info table and used by the GHCi debugger and the heap profiler ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1021,6 +1021,9 @@ lintIdOcc var nargs ; checkDeadIdOcc var ; checkJoinOcc var nargs + ; case isDataConId_maybe var of + Nothing -> return () + Just dc -> checkTypeDataConOcc "expression" dc ; usage <- varCallSiteUsage var @@ -1107,6 +1110,13 @@ checkJoinOcc var n_args | otherwise = return () +checkTypeDataConOcc :: String -> DataCon -> LintM () +-- Check that the Id is not a data constructor of a `type data` declaration +-- Invariant (I1) of Note [Type data declarations] in GHC.Rename.Module +checkTypeDataConOcc what dc + = checkL (not (isTypeDataTyCon (dataConTyCon dc))) $ + (text "type data constructor found in a" <+> text what <> colon <+> ppr dc) + -- | This function checks that we are able to perform eta expansion for -- functions with no binding, in order to satisfy invariant I3 -- from Note [Representation polymorphism invariants] in GHC.Core. @@ -1561,10 +1571,11 @@ lintCoreAlt case_bndr scrut_ty _scrut_mult alt_ty alt@(Alt (DataAlt con) args rh = zeroUE <$ addErrL (mkNewTyDataConAltMsg scrut_ty alt) | Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty = addLoc (CaseAlt alt) $ do - { -- First instantiate the universally quantified - -- type variables of the data constructor - -- We've already check - lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + { checkTypeDataConOcc "pattern" con + ; lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + + -- Instantiate the universally quantified + -- type variables of the data constructor ; let { con_payload_ty = piResultTys (dataConRepType con) tycon_arg_tys ; binderMult (Named _) = ManyTy ; binderMult (Anon st _) = scaledMult st ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, tyConDataCons - , tyConFamilySize ) + , tyConFamilySize, isTypeDataTyCon ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey ) @@ -3184,6 +3184,8 @@ caseRules _ (App (App (Var f) (Type ty)) v) -- dataToTag x | Just DataToTagOp <- isPrimOpId_maybe f , Just (tc, _) <- tcSplitTyConApp_maybe ty , isAlgTyCon tc + , not (isTypeDataTyCon tc) -- See wrinkle (W2c) in GHC.Rename.Module + -- Note [Type data declarations] = Just (v, tx_con_dtt ty , \v -> App (App (Var f) (Type ty)) (Var v)) ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -845,7 +845,8 @@ There are two exceptions where we avoid refining a DEFAULT case: __DEFAULT -> () Namely, we do _not_ want to match on `A`, as it doesn't exist at the value - level! + level! See wrinkle (W2b) in Note [Type data declarations] in GHC.Rename.Module + Note [Combine identical alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -152,8 +152,8 @@ vanillaCompleteMatchTC tc = tc == tYPETyCon = Just [] | -- Similarly, treat `type data` declarations as empty data types on -- the term level, as `type data` data constructors only exist at - -- the type level (#22964). - -- See Note [Type data declarations] in GHC.Rename.Module. + -- the type level (#22964). See wrinkle (W2a) in + -- Note [Type data declarations] in GHC.Rename.Module. isTypeDataTyCon tc = Just [] | otherwise = tyConDataCons_maybe tc in vanillaCompleteMatch . mkUniqDSet . map RealDataCon <$> mb_dcs ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2073,9 +2073,79 @@ preceded by `type`, with the following restrictions: (R5) There are no deriving clauses. +The data constructors of a `type data` declaration obey the following +Core invariant: + +(I1) The data constructors of a `type data` declaration may be mentioned in + /types/, but never in /terms/ or the /pattern of a case alternative/. + +Wrinkles: + +(W0) Wrappers. The data constructor of a `type data` declaration has a worker + (like every data constructor) but does /not/ have a wrapper. Wrappers + only make sense for value-level data constructors. Indeed, the worker Id + is never used (invariant (I1)), so it barely makes sense to talk about + the worker. A `type data` constructor only shows up in types, where it + appears as a TyCon, specifically a PromotedDataCon -- no Id in sight. + + See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where + this check is implemented. + + This specifically includes `type data` declarations implemented as GADTs, + such as this example from #22948: + + type data T a where + A :: T Int + B :: T a + + If `T` were an ordinary `data` declaration, then `A` would have a wrapper + to account for the GADT-like equality in its return type. Because `T` is + declared as a `type data` declaration, however, the wrapper is omitted. + +(W1) To prevent users from conjuring up `type data` values at the term level, + we disallow using the tagToEnum# function on a type headed by a `type + data` type. For instance, GHC will reject this code: + + type data Letter = A | B | C + + f :: Letter + f = tagToEnum# 0# + + See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. + +(W2) Although `type data` data constructors do not exist at the value level, + it is still possible to match on a value whose type is headed by a `type data` + type constructor, such as this example from #22964: + + type data T a where + A :: T Int + B :: T a + + f :: T a -> () + f x = case x of {} + + And yet we must guarantee invariant (I1). This has three consequences: + + (W2a) During checking the coverage of `f`'s pattern matches, we treat `T` + as if it were an empty data type so that GHC does not warn the user + to match against `A` or `B`. (Otherwise, you end up with the bug + reported in #22964.) See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. + + (W2b) In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case + with the data constructor, else (I1) is violated. See GHC.Core.Utils + Note [Refine DEFAULT case alternatives] Exception 2 + + (W2c) In `GHC.Core.Opt.ConstantFold.caseRules`, disable the rule for + `dataToTag#` in the case of `type data`. We do not want to transform + case dataToTag# x of t -> blah + into + case x of { A -> ...; B -> .. } + because again that conjures up the type-level-only data contructors + `A` and `B` in a pattern, violating (I1) (#23023). + The main parts of the implementation are: -* (R0): The parser recognizes `type data` (but not `type newtype`). +* The parser recognizes `type data` (but not `type newtype`); this ensures (R0). * During the initial construction of the AST, GHC.Parser.PostProcess.checkNewOrData sets the `Bool` argument of the @@ -2134,54 +2204,6 @@ The main parts of the implementation are: `type data` declarations. When these are converted back to Hs types in a splice, the constructors are placed in the TcCls namespace. -* A `type data` declaration _never_ generates wrappers for its data - constructors, as they only make sense for value-level data constructors. - See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where - this check is implemented. - - This includes `type data` declarations implemented as GADTs, such as - this example from #22948: - - type data T a where - A :: T Int - B :: T a - - If `T` were an ordinary `data` declaration, then `A` would have a wrapper - to account for the GADT-like equality in its return type. Because `T` is - declared as a `type data` declaration, however, the wrapper is omitted. - -* Although `type data` data constructors do not exist at the value level, - it is still possible to match on a value whose type is headed by a `type data` - type constructor, such as this example from #22964: - - type data T a where - A :: T Int - B :: T a - - f :: T a -> () - f x = case x of {} - - This has two consequences: - - * During checking the coverage of `f`'s pattern matches, we treat `T` as if it - were an empty data type so that GHC does not warn the user to match against - `A` or `B`. (Otherwise, you end up with the bug reported in #22964.) - See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. - - * In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case with - the data constructor. See - Note [Refine DEFAULT case alternatives] Exception 2, in GHC.Core.Utils. - -* To prevent users from conjuring up `type data` values at the term level, we - disallow using the tagToEnum# function on a type headed by a `type data` - type. For instance, GHC will reject this code: - - type data Letter = A | B | C - - f :: Letter - f = tagToEnum# 0# - - See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -1222,7 +1222,8 @@ tcTagToEnum tc_fun fun_ctxt tc_args res_ty vanilla_result = rebuildHsApps tc_fun fun_ctxt tc_args res_ty check_enumeration ty' tc - | -- isTypeDataTyCon: see Note [Type data declarations] in GHC.Rename.Module + | -- isTypeDataTyCon: see wrinkle (W1) in + -- Note [Type data declarations] in GHC.Rename.Module isTypeDataTyCon tc = addErrTc (TcRnTagToEnumResTyTypeData ty') | isEnumerationTyCon tc = return () | otherwise = addErrTc (TcRnTagToEnumResTyNotAnEnum ty') ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -46,6 +46,7 @@ Runtime system ``base`` library ~~~~~~~~~~~~~~~~ +- ``Data.Tuple`` now exports ``getSolo :: Solo a -> a``. ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/Data/Tuple.hs ===================================== @@ -17,6 +17,7 @@ module Data.Tuple ( Solo (..) + , getSolo , fst , snd , curry @@ -25,7 +26,7 @@ module Data.Tuple ) where import GHC.Base () -- Note [Depend on GHC.Tuple] -import GHC.Tuple (Solo (..)) +import GHC.Tuple (Solo (..), getSolo) default () -- Double isn't available yet ===================================== libraries/base/changelog.md ===================================== @@ -7,6 +7,8 @@ * Refactor `generalCategory` to stop very large literal string being inlined to call-sites. ([CLC proposal #130](https://github.com/haskell/core-libraries-committee/issues/130)) * Add INLINABLE pragmas to `generic*` functions in Data.OldList ([CLC proposal #129](https://github.com/haskell/core-libraries-committee/issues/130)) + * Export `getSolo` from `Data.Tuple`. + ([CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113)) ## 4.18.0.0 *TBA* ===================================== libraries/ghc-prim/GHC/Tuple/Prim.hs ===================================== @@ -79,6 +79,26 @@ data () = () -- implementations of lazy and strict mapping functions. data Solo a = MkSolo a +-- | Extract the value from a 'Solo'. Very often, values should be extracted +-- directly using pattern matching, to control just what gets evaluated when. +-- @getSolo@ is for convenience in situations where that is not the case: +-- +-- When the result is passed to a /strict/ function, it makes no difference +-- whether the pattern matching is done on the \"outside\" or on the +-- \"inside\": +-- +-- @ +-- Data.Set.insert (getSolo sol) set === case sol of Solo v -> Data.Set.insert v set +-- @ +-- +-- A traversal may be performed in 'Solo' in order to control evaluation +-- internally, while using @getSolo@ to extract the final result. A strict +-- mapping function, for example, could be defined +-- +-- @ +-- map' :: Traversable t => (a -> b) -> t a -> t b +-- map' f = getSolo . traverse ((Solo $!) . f) +-- @ getSolo :: Solo a -> a -- getSolo is a standalone function, rather than a record field of Solo, -- because Solo is a wired-in TyCon, and a wired-in TyCon that has ===================================== testsuite/tests/gadt/T23022.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module B where + +type data T a b where + MkT :: T a a + +f :: T a b -> T a b +f x = x ===================================== testsuite/tests/gadt/T23023.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeData, MagicHash #-} +module B where + +import GHC.Exts + +type data T a b where + MkT :: T a a + +f :: T Int Bool -> Char +f x = case dataToTag# x of + 0# -> 'a' + _ -> 'b' ===================================== testsuite/tests/gadt/all.T ===================================== @@ -129,3 +129,5 @@ test('T22235', normal, compile, ['']) test('T19847', normal, compile, ['']) test('T19847a', normal, compile, ['-ddump-types']) test('T19847b', normal, compile, ['']) +test('T23022', normal, compile, ['-dcore-lint']) +test('T23023', normal, compile, ['-dcore-lint']) ===================================== testsuite/tests/polykinds/T22793.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module T22793 where + +import Data.Kind + +type Foo :: forall k. k -> k -> Constraint + +class Foo s a + +bob :: forall {k1} {ks} {ka} q (p :: k1 -> q -> Type) + (f :: ka -> q) (s :: ks) (t :: ks) + (a :: ka) (b :: ka). Foo s a + => p a (f b) -> p s (f t) +bob f = undefined ===================================== testsuite/tests/polykinds/T22793.stderr ===================================== @@ -0,0 +1,44 @@ + +T22793.hs:15:42: error: [GHC-25897] + • Couldn't match kind ‘ka’ with ‘k1’ + Expected kind ‘ks’, but ‘a’ has kind ‘ka’ + ‘ka’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:26-27 + ‘k1’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:16-17 + • In the second argument of ‘Foo’, namely ‘a’ + In the type signature: + bob :: forall {k1} + {ks} + {ka} + q + (p :: k1 -> q -> Type) + (f :: ka -> q) + (s :: ks) + (t :: ks) + (a :: ka) + (b :: ka). Foo s a => p a (f b) -> p s (f t) + +T22793.hs:16:11: error: [GHC-25897] + • Couldn't match kind ‘ks’ with ‘k1’ + Expected kind ‘k1’, but ‘a’ has kind ‘ka’ + ‘ks’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:21-22 + ‘k1’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:16-17 + • In the first argument of ‘p’, namely ‘a’ + In the type signature: + bob :: forall {k1} + {ks} + {ka} + q + (p :: k1 -> q -> Type) + (f :: ka -> q) + (s :: ks) + (t :: ks) + (a :: ka) + (b :: ka). Foo s a => p a (f b) -> p s (f t) ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -243,3 +243,4 @@ test('T22379a', normal, compile, ['']) test('T22379b', normal, compile, ['']) test('T22743', normal, compile_fail, ['']) test('T22742', normal, compile_fail, ['']) +test('T22793', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ba4a2dda4abf17d36b55cd7625bbfa160a5b1f9...c7c1a73b6e93e505b06736cbb6f8be79fdca32c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ba4a2dda4abf17d36b55cd7625bbfa160a5b1f9...c7c1a73b6e93e505b06736cbb6f8be79fdca32c1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 4 03:47:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 03 Mar 2023 22:47:50 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Export getSolo from Data.Tuple Message-ID: <6402bf66f87d_3ab52b2699e000601131@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - 1121bb3a by Simon Peyton Jones at 2023-03-03T22:47:38-05:00 Add test for T22793 - - - - - 23 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Gen/App.hs - docs/users_guide/9.8.1-notes.rst - libraries/base/Data/Tuple.hs - libraries/base/Data/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/Type/Reflection.hs - libraries/base/changelog.md - libraries/ghc-prim/GHC/Tuple/Prim.hs - + testsuite/tests/gadt/T23022.hs - + testsuite/tests/gadt/T23023.hs - testsuite/tests/gadt/all.T - testsuite/tests/ghci/scripts/T9181.stdout - + testsuite/tests/polykinds/T22793.hs - + testsuite/tests/polykinds/T22793.stderr - testsuite/tests/polykinds/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1669,13 +1669,25 @@ dataConOtherTheta dc = dcOtherTheta dc -- evidence, after any flattening has been done and without substituting for -- any type variables dataConRepArgTys :: DataCon -> [Scaled Type] -dataConRepArgTys (MkData { dcRep = rep - , dcEqSpec = eq_spec +dataConRepArgTys (MkData { dcRep = rep + , dcEqSpec = eq_spec , dcOtherTheta = theta - , dcOrigArgTys = orig_arg_tys }) + , dcOrigArgTys = orig_arg_tys + , dcRepTyCon = tc }) = case rep of - NoDataConRep -> assert (null eq_spec) $ map unrestricted theta ++ orig_arg_tys DCR { dcr_arg_tys = arg_tys } -> arg_tys + NoDataConRep + | isTypeDataTyCon tc -> assert (null theta) $ + orig_arg_tys + -- `type data` declarations can be GADTs (and hence have an eq_spec) + -- but no wrapper. They cannot have a theta. + -- See Note [Type data declarations] in GHC.Rename.Module + -- You might wonder why we ever call dataConRepArgTys for `type data`; + -- I think it's because of the call in mkDataCon, which in turn feeds + -- into dcRepArity, which in turn is used in mkDataConWorkId. + -- c.f. #23022 + | otherwise -> assert (null eq_spec) $ + map unrestricted theta ++ orig_arg_tys -- | The string @package:module.name@ identifying a constructor, which is attached -- to its info table and used by the GHCi debugger and the heap profiler ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1021,6 +1021,9 @@ lintIdOcc var nargs ; checkDeadIdOcc var ; checkJoinOcc var nargs + ; case isDataConId_maybe var of + Nothing -> return () + Just dc -> checkTypeDataConOcc "expression" dc ; usage <- varCallSiteUsage var @@ -1107,6 +1110,13 @@ checkJoinOcc var n_args | otherwise = return () +checkTypeDataConOcc :: String -> DataCon -> LintM () +-- Check that the Id is not a data constructor of a `type data` declaration +-- Invariant (I1) of Note [Type data declarations] in GHC.Rename.Module +checkTypeDataConOcc what dc + = checkL (not (isTypeDataTyCon (dataConTyCon dc))) $ + (text "type data constructor found in a" <+> text what <> colon <+> ppr dc) + -- | This function checks that we are able to perform eta expansion for -- functions with no binding, in order to satisfy invariant I3 -- from Note [Representation polymorphism invariants] in GHC.Core. @@ -1561,10 +1571,11 @@ lintCoreAlt case_bndr scrut_ty _scrut_mult alt_ty alt@(Alt (DataAlt con) args rh = zeroUE <$ addErrL (mkNewTyDataConAltMsg scrut_ty alt) | Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty = addLoc (CaseAlt alt) $ do - { -- First instantiate the universally quantified - -- type variables of the data constructor - -- We've already check - lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + { checkTypeDataConOcc "pattern" con + ; lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + + -- Instantiate the universally quantified + -- type variables of the data constructor ; let { con_payload_ty = piResultTys (dataConRepType con) tycon_arg_tys ; binderMult (Named _) = ManyTy ; binderMult (Anon st _) = scaledMult st ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, tyConDataCons - , tyConFamilySize ) + , tyConFamilySize, isTypeDataTyCon ) import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey ) @@ -3184,6 +3184,8 @@ caseRules _ (App (App (Var f) (Type ty)) v) -- dataToTag x | Just DataToTagOp <- isPrimOpId_maybe f , Just (tc, _) <- tcSplitTyConApp_maybe ty , isAlgTyCon tc + , not (isTypeDataTyCon tc) -- See wrinkle (W2c) in GHC.Rename.Module + -- Note [Type data declarations] = Just (v, tx_con_dtt ty , \v -> App (App (Var f) (Type ty)) (Var v)) ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -845,7 +845,8 @@ There are two exceptions where we avoid refining a DEFAULT case: __DEFAULT -> () Namely, we do _not_ want to match on `A`, as it doesn't exist at the value - level! + level! See wrinkle (W2b) in Note [Type data declarations] in GHC.Rename.Module + Note [Combine identical alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -152,8 +152,8 @@ vanillaCompleteMatchTC tc = tc == tYPETyCon = Just [] | -- Similarly, treat `type data` declarations as empty data types on -- the term level, as `type data` data constructors only exist at - -- the type level (#22964). - -- See Note [Type data declarations] in GHC.Rename.Module. + -- the type level (#22964). See wrinkle (W2a) in + -- Note [Type data declarations] in GHC.Rename.Module. isTypeDataTyCon tc = Just [] | otherwise = tyConDataCons_maybe tc in vanillaCompleteMatch . mkUniqDSet . map RealDataCon <$> mb_dcs ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2073,9 +2073,79 @@ preceded by `type`, with the following restrictions: (R5) There are no deriving clauses. +The data constructors of a `type data` declaration obey the following +Core invariant: + +(I1) The data constructors of a `type data` declaration may be mentioned in + /types/, but never in /terms/ or the /pattern of a case alternative/. + +Wrinkles: + +(W0) Wrappers. The data constructor of a `type data` declaration has a worker + (like every data constructor) but does /not/ have a wrapper. Wrappers + only make sense for value-level data constructors. Indeed, the worker Id + is never used (invariant (I1)), so it barely makes sense to talk about + the worker. A `type data` constructor only shows up in types, where it + appears as a TyCon, specifically a PromotedDataCon -- no Id in sight. + + See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where + this check is implemented. + + This specifically includes `type data` declarations implemented as GADTs, + such as this example from #22948: + + type data T a where + A :: T Int + B :: T a + + If `T` were an ordinary `data` declaration, then `A` would have a wrapper + to account for the GADT-like equality in its return type. Because `T` is + declared as a `type data` declaration, however, the wrapper is omitted. + +(W1) To prevent users from conjuring up `type data` values at the term level, + we disallow using the tagToEnum# function on a type headed by a `type + data` type. For instance, GHC will reject this code: + + type data Letter = A | B | C + + f :: Letter + f = tagToEnum# 0# + + See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. + +(W2) Although `type data` data constructors do not exist at the value level, + it is still possible to match on a value whose type is headed by a `type data` + type constructor, such as this example from #22964: + + type data T a where + A :: T Int + B :: T a + + f :: T a -> () + f x = case x of {} + + And yet we must guarantee invariant (I1). This has three consequences: + + (W2a) During checking the coverage of `f`'s pattern matches, we treat `T` + as if it were an empty data type so that GHC does not warn the user + to match against `A` or `B`. (Otherwise, you end up with the bug + reported in #22964.) See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. + + (W2b) In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case + with the data constructor, else (I1) is violated. See GHC.Core.Utils + Note [Refine DEFAULT case alternatives] Exception 2 + + (W2c) In `GHC.Core.Opt.ConstantFold.caseRules`, disable the rule for + `dataToTag#` in the case of `type data`. We do not want to transform + case dataToTag# x of t -> blah + into + case x of { A -> ...; B -> .. } + because again that conjures up the type-level-only data contructors + `A` and `B` in a pattern, violating (I1) (#23023). + The main parts of the implementation are: -* (R0): The parser recognizes `type data` (but not `type newtype`). +* The parser recognizes `type data` (but not `type newtype`); this ensures (R0). * During the initial construction of the AST, GHC.Parser.PostProcess.checkNewOrData sets the `Bool` argument of the @@ -2134,54 +2204,6 @@ The main parts of the implementation are: `type data` declarations. When these are converted back to Hs types in a splice, the constructors are placed in the TcCls namespace. -* A `type data` declaration _never_ generates wrappers for its data - constructors, as they only make sense for value-level data constructors. - See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where - this check is implemented. - - This includes `type data` declarations implemented as GADTs, such as - this example from #22948: - - type data T a where - A :: T Int - B :: T a - - If `T` were an ordinary `data` declaration, then `A` would have a wrapper - to account for the GADT-like equality in its return type. Because `T` is - declared as a `type data` declaration, however, the wrapper is omitted. - -* Although `type data` data constructors do not exist at the value level, - it is still possible to match on a value whose type is headed by a `type data` - type constructor, such as this example from #22964: - - type data T a where - A :: T Int - B :: T a - - f :: T a -> () - f x = case x of {} - - This has two consequences: - - * During checking the coverage of `f`'s pattern matches, we treat `T` as if it - were an empty data type so that GHC does not warn the user to match against - `A` or `B`. (Otherwise, you end up with the bug reported in #22964.) - See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. - - * In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case with - the data constructor. See - Note [Refine DEFAULT case alternatives] Exception 2, in GHC.Core.Utils. - -* To prevent users from conjuring up `type data` values at the term level, we - disallow using the tagToEnum# function on a type headed by a `type data` - type. For instance, GHC will reject this code: - - type data Letter = A | B | C - - f :: Letter - f = tagToEnum# 0# - - See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -1222,7 +1222,8 @@ tcTagToEnum tc_fun fun_ctxt tc_args res_ty vanilla_result = rebuildHsApps tc_fun fun_ctxt tc_args res_ty check_enumeration ty' tc - | -- isTypeDataTyCon: see Note [Type data declarations] in GHC.Rename.Module + | -- isTypeDataTyCon: see wrinkle (W1) in + -- Note [Type data declarations] in GHC.Rename.Module isTypeDataTyCon tc = addErrTc (TcRnTagToEnumResTyTypeData ty') | isEnumerationTyCon tc = return () | otherwise = addErrTc (TcRnTagToEnumResTyNotAnEnum ty') ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -46,6 +46,7 @@ Runtime system ``base`` library ~~~~~~~~~~~~~~~~ +- ``Data.Tuple`` now exports ``getSolo :: Solo a -> a``. ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/Data/Tuple.hs ===================================== @@ -17,6 +17,7 @@ module Data.Tuple ( Solo (..) + , getSolo , fst , snd , curry @@ -25,7 +26,7 @@ module Data.Tuple ) where import GHC.Base () -- Note [Depend on GHC.Tuple] -import GHC.Tuple (Solo (..)) +import GHC.Tuple (Solo (..), getSolo) default () -- Double isn't available yet ===================================== libraries/base/Data/Typeable.hs ===================================== @@ -58,6 +58,8 @@ module Data.Typeable , cast , eqT , heqT + , decT + , hdecT , gcast -- a generalisation of cast -- * Generalized casts for higher-order kinds @@ -99,6 +101,7 @@ import qualified Data.Typeable.Internal as I import Data.Typeable.Internal (Typeable) import Data.Type.Equality +import Data.Either import Data.Maybe import Data.Proxy import GHC.Fingerprint.Type @@ -140,6 +143,14 @@ eqT | Just HRefl <- heqT @a @b = Just Refl | otherwise = Nothing +-- | Decide an equality of two types +-- +-- @since 4.19.0.0 +decT :: forall a b. (Typeable a, Typeable b) => Either (a :~: b -> Void) (a :~: b) +decT = case hdecT @a @b of + Right HRefl -> Right Refl + Left p -> Left (\Refl -> p HRefl) + -- | Extract a witness of heterogeneous equality of two types -- -- @since 4.18.0.0 @@ -149,6 +160,15 @@ heqT = ta `I.eqTypeRep` tb ta = I.typeRep :: I.TypeRep a tb = I.typeRep :: I.TypeRep b +-- | Decide heterogeneous equality of two types. +-- +-- @since 4.19.0.0 +hdecT :: forall a b. (Typeable a, Typeable b) => Either (a :~~: b -> Void) (a :~~: b) +hdecT = ta `I.decTypeRep` tb + where + ta = I.typeRep :: I.TypeRep a + tb = I.typeRep :: I.TypeRep b + -- | A flexible variation parameterised in a type constructor gcast :: forall a b c. (Typeable a, Typeable b) => c a -> Maybe (c b) gcast x = fmap (\Refl -> x) (eqT :: Maybe (a :~: b)) ===================================== libraries/base/Data/Typeable/Internal.hs ===================================== @@ -66,6 +66,7 @@ module Data.Typeable.Internal ( typeRepFingerprint, rnfTypeRep, eqTypeRep, + decTypeRep, typeRepKind, splitApps, @@ -88,6 +89,7 @@ module Data.Typeable.Internal ( import GHC.Base import qualified GHC.Arr as A +import Data.Either (Either (..)) import Data.Type.Equality import GHC.List ( splitAt, foldl', elem ) import GHC.Word @@ -611,14 +613,48 @@ typeRepTyCon (TrFun {}) = typeRepTyCon $ typeRep @(->) -- @since 4.10 eqTypeRep :: forall k1 k2 (a :: k1) (b :: k2). TypeRep a -> TypeRep b -> Maybe (a :~~: b) -eqTypeRep a b - | sameTypeRep a b = Just (unsafeCoerce HRefl) - | otherwise = Nothing --- We want GHC to inline eqTypeRep to get rid of the Maybe --- in the usual case that it is scrutinized immediately. We --- split eqTypeRep into a worker and wrapper because otherwise --- it's much larger than anything we'd want to inline. -{-# INLINABLE eqTypeRep #-} +eqTypeRep a b = case inline decTypeRep a b of + -- inline: see wrinkle (I1) in Note [Inlining eqTypeRep/decTypeRep] + Right p -> Just p + Left _ -> Nothing + +-- | Type equality decision +-- +-- @since 4.19.0.0 +decTypeRep :: forall k1 k2 (a :: k1) (b :: k2). + TypeRep a -> TypeRep b -> Either (a :~~: b -> Void) (a :~~: b) +decTypeRep a b + | sameTypeRep a b = Right (unsafeCoerce HRefl) + | otherwise = Left (\HRefl -> errorWithoutStackTrace ("decTypeRep: Impossible equality proof " ++ show a ++ " :~: " ++ show b)) + +{-# INLINEABLE eqTypeRep #-} +{-# INLINEABLE decTypeRep #-} + +{- +Note [Inlining eqTypeRep/decTypeRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +We want GHC to inline eqTypeRep and decTypeRep to get rid of the Maybe +and Either in the usual case that it is scrutinized immediately. We +split them into a worker (sameTypeRep) and wrappers because otherwise +it's much larger than anything we'd want to inline. + +We need INLINEABLE on the eqTypeRep and decTypeRep as GHC +seems to want to inline sameTypeRep here, making tham bigger. +By exposing exact RHS, they stay small and other optimizations may +fire first, so GHC can realise that inlining sameTypeRep is often +(but not always) a bad idea. + +Wrinkle I1: + +`inline decTypeRep` in eqTypeRep implementation is to ensure that `decTypeRep` +is inlined, even it's somewhat big of expression, but we know that big Left +branch will be optimized away. + +See discussion in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9524 +and also https://gitlab.haskell.org/ghc/ghc/-/issues/22635 + +-} sameTypeRep :: forall k1 k2 (a :: k1) (b :: k2). TypeRep a -> TypeRep b -> Bool ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -44,6 +44,7 @@ module GHC.TypeLits , N.SomeNat(..), SomeSymbol(..), SomeChar(..) , someNatVal, someSymbolVal, someCharVal , N.sameNat, sameSymbol, sameChar + , N.decideNat, decideSymbol, decideChar , OrderingI(..) , N.cmpNat, cmpSymbol, cmpChar -- ** Singleton values @@ -68,7 +69,8 @@ module GHC.TypeLits ) where import GHC.Base ( Eq(..), Functor(..), Ord(..), Ordering(..), String - , (.), otherwise, withDict ) + , (.), otherwise, withDict, Void, (++) + , errorWithoutStackTrace) import GHC.Types(Symbol, Char, TYPE) import GHC.TypeError(ErrorMessage(..), TypeError) import GHC.Num(Integer, fromInteger) @@ -76,7 +78,8 @@ import GHC.Show(Show(..), appPrec, appPrec1, showParen, showString) import GHC.Read(Read(..)) import GHC.Real(toInteger) import GHC.Prim(Proxy#) -import Data.Maybe(Maybe(..)) +import Data.Either (Either (..)) +import Data.Maybe (Maybe(..)) import Data.Proxy (Proxy(..)) import Data.Type.Coercion (Coercion(..), TestCoercion(..)) import Data.Type.Equality((:~:)(Refl), TestEquality(..)) @@ -224,6 +227,20 @@ sameSymbol :: forall a b proxy1 proxy2. proxy1 a -> proxy2 b -> Maybe (a :~: b) sameSymbol _ _ = testEquality (symbolSing @a) (symbolSing @b) +-- | We either get evidence that this function was instantiated with the +-- same type-level symbols, or that the type-level symbols are distinct. +-- +-- @since 4.19.0.0 +decideSymbol :: forall a b proxy1 proxy2. + (KnownSymbol a, KnownSymbol b) => + proxy1 a -> proxy2 b -> Either (a :~: b -> Void) (a :~: b) +decideSymbol _ _ = decSymbol (symbolSing @a) (symbolSing @b) + +-- Not exported: See [Not exported decNat, decSymbol and decChar] +decSymbol :: SSymbol a -> SSymbol b -> Either (a :~: b -> Void) (a :~: b) +decSymbol (UnsafeSSymbol x) (UnsafeSSymbol y) + | x == y = Right (unsafeCoerce Refl) + | otherwise = Left (\Refl -> errorWithoutStackTrace ("decideSymbol: Impossible equality proof " ++ show x ++ " :~: " ++ show y)) -- | We either get evidence that this function was instantiated with the -- same type-level characters, or 'Nothing'. @@ -234,6 +251,21 @@ sameChar :: forall a b proxy1 proxy2. proxy1 a -> proxy2 b -> Maybe (a :~: b) sameChar _ _ = testEquality (charSing @a) (charSing @b) +-- | We either get evidence that this function was instantiated with the +-- same type-level characters, or that the type-level characters are distinct. +-- +-- @since 4.19.0.0 +decideChar :: forall a b proxy1 proxy2. + (KnownChar a, KnownChar b) => + proxy1 a -> proxy2 b -> Either (a :~: b -> Void) (a :~: b) +decideChar _ _ = decChar (charSing @a) (charSing @b) + +-- Not exported: See [Not exported decNat, decSymbol and decChar] +decChar :: SChar a -> SChar b -> Either (a :~: b -> Void) (a :~: b) +decChar (UnsafeSChar x) (UnsafeSChar y) + | x == y = Right (unsafeCoerce Refl) + | otherwise = Left (\Refl -> errorWithoutStackTrace ("decideChar: Impossible equality proof " ++ show x ++ " :~: " ++ show y)) + -- | Like 'sameSymbol', but if the symbols aren't equal, this additionally -- provides proof of LT or GT. -- @@ -352,9 +384,9 @@ instance Show (SSymbol s) where -- | @since 4.18.0.0 instance TestEquality SSymbol where - testEquality (UnsafeSSymbol x) (UnsafeSSymbol y) - | x == y = Just (unsafeCoerce Refl) - | otherwise = Nothing + testEquality a b = case decSymbol a b of + Right p -> Just p + Left _ -> Nothing -- | @since 4.18.0.0 instance TestCoercion SSymbol where @@ -445,9 +477,9 @@ instance Show (SChar c) where -- | @since 4.18.0.0 instance TestEquality SChar where - testEquality (UnsafeSChar x) (UnsafeSChar y) - | x == y = Just (unsafeCoerce Refl) - | otherwise = Nothing + testEquality a b = case decChar a b of + Right p -> Just p + Left _ -> Nothing -- | @since 4.18.0.0 instance TestCoercion SChar where ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -33,6 +33,7 @@ module GHC.TypeNats , SomeNat(..) , someNatVal , sameNat + , decideNat -- ** Singleton values , SNat , pattern SNat @@ -48,12 +49,14 @@ module GHC.TypeNats ) where -import GHC.Base(Eq(..), Functor(..), Ord(..), WithDict(..), (.), otherwise) +import GHC.Base( Eq(..), Functor(..), Ord(..), WithDict(..), (.), otherwise + , Void, errorWithoutStackTrace, (++)) import GHC.Types import GHC.Num.Natural(Natural) import GHC.Show(Show(..), appPrec, appPrec1, showParen, showString) import GHC.Read(Read(..)) import GHC.Prim(Proxy#) +import Data.Either(Either(..)) import Data.Maybe(Maybe(..)) import Data.Proxy (Proxy(..)) import Data.Type.Coercion (Coercion(..), TestCoercion(..)) @@ -239,6 +242,73 @@ sameNat :: forall a b proxy1 proxy2. proxy1 a -> proxy2 b -> Maybe (a :~: b) sameNat _ _ = testEquality (natSing @a) (natSing @b) +-- | We either get evidence that this function was instantiated with the +-- same type-level numbers, or that the type-level numbers are distinct. +-- +-- @since 4.19.0.0 +decideNat :: forall a b proxy1 proxy2. + (KnownNat a, KnownNat b) => + proxy1 a -> proxy2 b -> Either (a :~: b -> Void) (a :~: b) +decideNat _ _ = decNat (natSing @a) (natSing @b) + +-- Not exported: See [Not exported decNat, decSymbol and decChar] +decNat :: SNat a -> SNat b -> Either (a :~: b -> Void) (a :~: b) +decNat (UnsafeSNat x) (UnsafeSNat y) + | x == y = Right (unsafeCoerce Refl) + | otherwise = Left (\Refl -> errorWithoutStackTrace ("decideNat: Impossible equality proof " ++ show x ++ " :~: " ++ show y)) + +{- +Note [Not exported decNat, decSymbol and decChar] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The decNat, decSymbol and decChar are not (yet) exported. + +There are two development paths: +1. export them. +2. Add `decideEquality :: f a -> f b -> Either (a :~: b -> Void) (a :~: b)` + to the `Data.Type.Equality.TestEquality` typeclass. + +The second option looks nicer given the current base API: +there aren't `eqNat :: SNat a -> SNat b -> Maybe (a :~: b)` like functions, +they are abstracted by `TestEquality` typeclass. + +Also TestEquality class has a law that testEquality result +should be Just Refl iff the types applied to are equal: + +testEquality (x :: f a) (y :: f b) = Just Refl <=> a = b + +As consequence we have that testEquality should be Nothing +iff the types applied are inequal: + +testEquality (x :: f a) (y :: f b) = Nothing <=> a /= b + +And the decideEquality would enforce that. + +However, adding a new method is a breaking change, +as default implementation cannot be (safely) provided. +Also there are unlawful instances of `TestEquality` out there, +(e.g. https://hackage.haskell.org/package/parameterized-utils Index instance + https://hackage.haskell.org/package/witness various types) +which makes adding unsafe default implementation a bad idea. + +Adding own typeclass: + +class TestEquality f => DecideEquality f where + decideEquality :: f a -> f b -> Either (a :~: b -> Void) (a :~: b) + +is bad design, as `TestEquality` already implies that it should be possible. +In other words, every f with (lawful) `TestEquality` instance should have +`DecideEquality` instance as well. + +We hold on doing either 1. or 2. yet, as doing 2. is "harder", +but if it is done eventually, doing 1. is pointless. +In other words the paths can be thought as mutually exclusive. + +Fortunately the dec* functions can be simulated using decide* variants +if needed, so there is no hurry to commit to either development paths. + +-} + -- | Like 'sameNat', but if the numbers aren't equal, this additionally -- provides proof of LT or GT. -- @@ -318,9 +388,9 @@ instance Show (SNat n) where -- | @since 4.18.0.0 instance TestEquality SNat where - testEquality (UnsafeSNat x) (UnsafeSNat y) - | x == y = Just (unsafeCoerce Refl) - | otherwise = Nothing + testEquality a b = case decNat a b of + Right x -> Just x + Left _ -> Nothing -- | @since 4.18.0.0 instance TestCoercion SNat where ===================================== libraries/base/Type/Reflection.hs ===================================== @@ -44,6 +44,7 @@ module Type.Reflection , I.typeRepTyCon , I.rnfTypeRep , I.eqTypeRep + , I.decTypeRep , I.typeRepKind , I.splitApps ===================================== libraries/base/changelog.md ===================================== @@ -7,6 +7,10 @@ * Refactor `generalCategory` to stop very large literal string being inlined to call-sites. ([CLC proposal #130](https://github.com/haskell/core-libraries-committee/issues/130)) * Add INLINABLE pragmas to `generic*` functions in Data.OldList ([CLC proposal #129](https://github.com/haskell/core-libraries-committee/issues/130)) + * Export `getSolo` from `Data.Tuple`. + ([CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113)) + * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. + ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) ## 4.18.0.0 *TBA* ===================================== libraries/ghc-prim/GHC/Tuple/Prim.hs ===================================== @@ -79,6 +79,26 @@ data () = () -- implementations of lazy and strict mapping functions. data Solo a = MkSolo a +-- | Extract the value from a 'Solo'. Very often, values should be extracted +-- directly using pattern matching, to control just what gets evaluated when. +-- @getSolo@ is for convenience in situations where that is not the case: +-- +-- When the result is passed to a /strict/ function, it makes no difference +-- whether the pattern matching is done on the \"outside\" or on the +-- \"inside\": +-- +-- @ +-- Data.Set.insert (getSolo sol) set === case sol of Solo v -> Data.Set.insert v set +-- @ +-- +-- A traversal may be performed in 'Solo' in order to control evaluation +-- internally, while using @getSolo@ to extract the final result. A strict +-- mapping function, for example, could be defined +-- +-- @ +-- map' :: Traversable t => (a -> b) -> t a -> t b +-- map' f = getSolo . traverse ((Solo $!) . f) +-- @ getSolo :: Solo a -> a -- getSolo is a standalone function, rather than a record field of Solo, -- because Solo is a wired-in TyCon, and a wired-in TyCon that has ===================================== testsuite/tests/gadt/T23022.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module B where + +type data T a b where + MkT :: T a a + +f :: T a b -> T a b +f x = x ===================================== testsuite/tests/gadt/T23023.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeData, MagicHash #-} +module B where + +import GHC.Exts + +type data T a b where + MkT :: T a a + +f :: T Int Bool -> Char +f x = case dataToTag# x of + 0# -> 'a' + _ -> 'b' ===================================== testsuite/tests/gadt/all.T ===================================== @@ -129,3 +129,5 @@ test('T22235', normal, compile, ['']) test('T19847', normal, compile, ['']) test('T19847a', normal, compile, ['-ddump-types']) test('T19847b', normal, compile, ['']) +test('T23022', normal, compile, ['-dcore-lint']) +test('T23023', normal, compile, ['-dcore-lint']) ===================================== testsuite/tests/ghci/scripts/T9181.stdout ===================================== @@ -48,6 +48,20 @@ GHC.TypeLits.cmpChar :: GHC.TypeLits.cmpSymbol :: (GHC.TypeLits.KnownSymbol a, GHC.TypeLits.KnownSymbol b) => proxy1 a -> proxy2 b -> Data.Type.Ord.OrderingI a b +GHC.TypeLits.decideChar :: + (GHC.TypeLits.KnownChar a, GHC.TypeLits.KnownChar b) => + proxy1 a + -> proxy2 b + -> Either + ((a Data.Type.Equality.:~: b) -> GHC.Base.Void) + (a Data.Type.Equality.:~: b) +GHC.TypeLits.decideSymbol :: + (GHC.TypeLits.KnownSymbol a, GHC.TypeLits.KnownSymbol b) => + proxy1 a + -> proxy2 b + -> Either + ((a Data.Type.Equality.:~: b) -> GHC.Base.Void) + (a Data.Type.Equality.:~: b) GHC.TypeLits.fromSChar :: GHC.TypeLits.SChar c -> Char GHC.TypeLits.fromSNat :: GHC.TypeNats.SNat n -> Integer GHC.TypeLits.fromSSymbol :: GHC.TypeLits.SSymbol s -> String @@ -172,6 +186,13 @@ type family (GHC.TypeNats.^) a b GHC.TypeNats.cmpNat :: (GHC.TypeNats.KnownNat a, GHC.TypeNats.KnownNat b) => proxy1 a -> proxy2 b -> Data.Type.Ord.OrderingI a b +GHC.TypeNats.decideNat :: + (GHC.TypeNats.KnownNat a, GHC.TypeNats.KnownNat b) => + proxy1 a + -> proxy2 b + -> Either + ((a Data.Type.Equality.:~: b) -> GHC.Base.Void) + (a Data.Type.Equality.:~: b) GHC.TypeNats.sameNat :: (GHC.TypeNats.KnownNat a, GHC.TypeNats.KnownNat b) => proxy1 a -> proxy2 b -> Maybe (a Data.Type.Equality.:~: b) ===================================== testsuite/tests/polykinds/T22793.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module T22793 where + +import Data.Kind + +type Foo :: forall k. k -> k -> Constraint + +class Foo s a + +bob :: forall {k1} {ks} {ka} q (p :: k1 -> q -> Type) + (f :: ka -> q) (s :: ks) (t :: ks) + (a :: ka) (b :: ka). Foo s a + => p a (f b) -> p s (f t) +bob f = undefined ===================================== testsuite/tests/polykinds/T22793.stderr ===================================== @@ -0,0 +1,44 @@ + +T22793.hs:15:42: error: [GHC-25897] + • Couldn't match kind ‘ka’ with ‘k1’ + Expected kind ‘ks’, but ‘a’ has kind ‘ka’ + ‘ka’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:26-27 + ‘k1’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:16-17 + • In the second argument of ‘Foo’, namely ‘a’ + In the type signature: + bob :: forall {k1} + {ks} + {ka} + q + (p :: k1 -> q -> Type) + (f :: ka -> q) + (s :: ks) + (t :: ks) + (a :: ka) + (b :: ka). Foo s a => p a (f b) -> p s (f t) + +T22793.hs:16:11: error: [GHC-25897] + • Couldn't match kind ‘ks’ with ‘k1’ + Expected kind ‘k1’, but ‘a’ has kind ‘ka’ + ‘ks’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:21-22 + ‘k1’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:16-17 + • In the first argument of ‘p’, namely ‘a’ + In the type signature: + bob :: forall {k1} + {ks} + {ka} + q + (p :: k1 -> q -> Type) + (f :: ka -> q) + (s :: ks) + (t :: ks) + (a :: ka) + (b :: ka). Foo s a => p a (f b) -> p s (f t) ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -243,3 +243,4 @@ test('T22379a', normal, compile, ['']) test('T22379b', normal, compile, ['']) test('T22743', normal, compile_fail, ['']) test('T22742', normal, compile_fail, ['']) +test('T22793', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/20d09ee2373cc340e76edfd01c31220864d778c6...1121bb3a87c4d05725b0491441113641a90a3bc7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/20d09ee2373cc340e76edfd01c31220864d778c6...1121bb3a87c4d05725b0491441113641a90a3bc7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 4 06:18:06 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 04 Mar 2023 01:18:06 -0500 Subject: [Git][ghc/ghc][master] Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT Message-ID: <6402e29e50247_3ab52b291f5b706157a0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - 7 changed files: - libraries/base/Data/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/Type/Reflection.hs - libraries/base/changelog.md - testsuite/tests/ghci/scripts/T9181.stdout Changes: ===================================== libraries/base/Data/Typeable.hs ===================================== @@ -58,6 +58,8 @@ module Data.Typeable , cast , eqT , heqT + , decT + , hdecT , gcast -- a generalisation of cast -- * Generalized casts for higher-order kinds @@ -99,6 +101,7 @@ import qualified Data.Typeable.Internal as I import Data.Typeable.Internal (Typeable) import Data.Type.Equality +import Data.Either import Data.Maybe import Data.Proxy import GHC.Fingerprint.Type @@ -140,6 +143,14 @@ eqT | Just HRefl <- heqT @a @b = Just Refl | otherwise = Nothing +-- | Decide an equality of two types +-- +-- @since 4.19.0.0 +decT :: forall a b. (Typeable a, Typeable b) => Either (a :~: b -> Void) (a :~: b) +decT = case hdecT @a @b of + Right HRefl -> Right Refl + Left p -> Left (\Refl -> p HRefl) + -- | Extract a witness of heterogeneous equality of two types -- -- @since 4.18.0.0 @@ -149,6 +160,15 @@ heqT = ta `I.eqTypeRep` tb ta = I.typeRep :: I.TypeRep a tb = I.typeRep :: I.TypeRep b +-- | Decide heterogeneous equality of two types. +-- +-- @since 4.19.0.0 +hdecT :: forall a b. (Typeable a, Typeable b) => Either (a :~~: b -> Void) (a :~~: b) +hdecT = ta `I.decTypeRep` tb + where + ta = I.typeRep :: I.TypeRep a + tb = I.typeRep :: I.TypeRep b + -- | A flexible variation parameterised in a type constructor gcast :: forall a b c. (Typeable a, Typeable b) => c a -> Maybe (c b) gcast x = fmap (\Refl -> x) (eqT :: Maybe (a :~: b)) ===================================== libraries/base/Data/Typeable/Internal.hs ===================================== @@ -66,6 +66,7 @@ module Data.Typeable.Internal ( typeRepFingerprint, rnfTypeRep, eqTypeRep, + decTypeRep, typeRepKind, splitApps, @@ -88,6 +89,7 @@ module Data.Typeable.Internal ( import GHC.Base import qualified GHC.Arr as A +import Data.Either (Either (..)) import Data.Type.Equality import GHC.List ( splitAt, foldl', elem ) import GHC.Word @@ -611,14 +613,48 @@ typeRepTyCon (TrFun {}) = typeRepTyCon $ typeRep @(->) -- @since 4.10 eqTypeRep :: forall k1 k2 (a :: k1) (b :: k2). TypeRep a -> TypeRep b -> Maybe (a :~~: b) -eqTypeRep a b - | sameTypeRep a b = Just (unsafeCoerce HRefl) - | otherwise = Nothing --- We want GHC to inline eqTypeRep to get rid of the Maybe --- in the usual case that it is scrutinized immediately. We --- split eqTypeRep into a worker and wrapper because otherwise --- it's much larger than anything we'd want to inline. -{-# INLINABLE eqTypeRep #-} +eqTypeRep a b = case inline decTypeRep a b of + -- inline: see wrinkle (I1) in Note [Inlining eqTypeRep/decTypeRep] + Right p -> Just p + Left _ -> Nothing + +-- | Type equality decision +-- +-- @since 4.19.0.0 +decTypeRep :: forall k1 k2 (a :: k1) (b :: k2). + TypeRep a -> TypeRep b -> Either (a :~~: b -> Void) (a :~~: b) +decTypeRep a b + | sameTypeRep a b = Right (unsafeCoerce HRefl) + | otherwise = Left (\HRefl -> errorWithoutStackTrace ("decTypeRep: Impossible equality proof " ++ show a ++ " :~: " ++ show b)) + +{-# INLINEABLE eqTypeRep #-} +{-# INLINEABLE decTypeRep #-} + +{- +Note [Inlining eqTypeRep/decTypeRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +We want GHC to inline eqTypeRep and decTypeRep to get rid of the Maybe +and Either in the usual case that it is scrutinized immediately. We +split them into a worker (sameTypeRep) and wrappers because otherwise +it's much larger than anything we'd want to inline. + +We need INLINEABLE on the eqTypeRep and decTypeRep as GHC +seems to want to inline sameTypeRep here, making tham bigger. +By exposing exact RHS, they stay small and other optimizations may +fire first, so GHC can realise that inlining sameTypeRep is often +(but not always) a bad idea. + +Wrinkle I1: + +`inline decTypeRep` in eqTypeRep implementation is to ensure that `decTypeRep` +is inlined, even it's somewhat big of expression, but we know that big Left +branch will be optimized away. + +See discussion in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9524 +and also https://gitlab.haskell.org/ghc/ghc/-/issues/22635 + +-} sameTypeRep :: forall k1 k2 (a :: k1) (b :: k2). TypeRep a -> TypeRep b -> Bool ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -44,6 +44,7 @@ module GHC.TypeLits , N.SomeNat(..), SomeSymbol(..), SomeChar(..) , someNatVal, someSymbolVal, someCharVal , N.sameNat, sameSymbol, sameChar + , N.decideNat, decideSymbol, decideChar , OrderingI(..) , N.cmpNat, cmpSymbol, cmpChar -- ** Singleton values @@ -68,7 +69,8 @@ module GHC.TypeLits ) where import GHC.Base ( Eq(..), Functor(..), Ord(..), Ordering(..), String - , (.), otherwise, withDict ) + , (.), otherwise, withDict, Void, (++) + , errorWithoutStackTrace) import GHC.Types(Symbol, Char, TYPE) import GHC.TypeError(ErrorMessage(..), TypeError) import GHC.Num(Integer, fromInteger) @@ -76,7 +78,8 @@ import GHC.Show(Show(..), appPrec, appPrec1, showParen, showString) import GHC.Read(Read(..)) import GHC.Real(toInteger) import GHC.Prim(Proxy#) -import Data.Maybe(Maybe(..)) +import Data.Either (Either (..)) +import Data.Maybe (Maybe(..)) import Data.Proxy (Proxy(..)) import Data.Type.Coercion (Coercion(..), TestCoercion(..)) import Data.Type.Equality((:~:)(Refl), TestEquality(..)) @@ -224,6 +227,20 @@ sameSymbol :: forall a b proxy1 proxy2. proxy1 a -> proxy2 b -> Maybe (a :~: b) sameSymbol _ _ = testEquality (symbolSing @a) (symbolSing @b) +-- | We either get evidence that this function was instantiated with the +-- same type-level symbols, or that the type-level symbols are distinct. +-- +-- @since 4.19.0.0 +decideSymbol :: forall a b proxy1 proxy2. + (KnownSymbol a, KnownSymbol b) => + proxy1 a -> proxy2 b -> Either (a :~: b -> Void) (a :~: b) +decideSymbol _ _ = decSymbol (symbolSing @a) (symbolSing @b) + +-- Not exported: See [Not exported decNat, decSymbol and decChar] +decSymbol :: SSymbol a -> SSymbol b -> Either (a :~: b -> Void) (a :~: b) +decSymbol (UnsafeSSymbol x) (UnsafeSSymbol y) + | x == y = Right (unsafeCoerce Refl) + | otherwise = Left (\Refl -> errorWithoutStackTrace ("decideSymbol: Impossible equality proof " ++ show x ++ " :~: " ++ show y)) -- | We either get evidence that this function was instantiated with the -- same type-level characters, or 'Nothing'. @@ -234,6 +251,21 @@ sameChar :: forall a b proxy1 proxy2. proxy1 a -> proxy2 b -> Maybe (a :~: b) sameChar _ _ = testEquality (charSing @a) (charSing @b) +-- | We either get evidence that this function was instantiated with the +-- same type-level characters, or that the type-level characters are distinct. +-- +-- @since 4.19.0.0 +decideChar :: forall a b proxy1 proxy2. + (KnownChar a, KnownChar b) => + proxy1 a -> proxy2 b -> Either (a :~: b -> Void) (a :~: b) +decideChar _ _ = decChar (charSing @a) (charSing @b) + +-- Not exported: See [Not exported decNat, decSymbol and decChar] +decChar :: SChar a -> SChar b -> Either (a :~: b -> Void) (a :~: b) +decChar (UnsafeSChar x) (UnsafeSChar y) + | x == y = Right (unsafeCoerce Refl) + | otherwise = Left (\Refl -> errorWithoutStackTrace ("decideChar: Impossible equality proof " ++ show x ++ " :~: " ++ show y)) + -- | Like 'sameSymbol', but if the symbols aren't equal, this additionally -- provides proof of LT or GT. -- @@ -352,9 +384,9 @@ instance Show (SSymbol s) where -- | @since 4.18.0.0 instance TestEquality SSymbol where - testEquality (UnsafeSSymbol x) (UnsafeSSymbol y) - | x == y = Just (unsafeCoerce Refl) - | otherwise = Nothing + testEquality a b = case decSymbol a b of + Right p -> Just p + Left _ -> Nothing -- | @since 4.18.0.0 instance TestCoercion SSymbol where @@ -445,9 +477,9 @@ instance Show (SChar c) where -- | @since 4.18.0.0 instance TestEquality SChar where - testEquality (UnsafeSChar x) (UnsafeSChar y) - | x == y = Just (unsafeCoerce Refl) - | otherwise = Nothing + testEquality a b = case decChar a b of + Right p -> Just p + Left _ -> Nothing -- | @since 4.18.0.0 instance TestCoercion SChar where ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -33,6 +33,7 @@ module GHC.TypeNats , SomeNat(..) , someNatVal , sameNat + , decideNat -- ** Singleton values , SNat , pattern SNat @@ -48,12 +49,14 @@ module GHC.TypeNats ) where -import GHC.Base(Eq(..), Functor(..), Ord(..), WithDict(..), (.), otherwise) +import GHC.Base( Eq(..), Functor(..), Ord(..), WithDict(..), (.), otherwise + , Void, errorWithoutStackTrace, (++)) import GHC.Types import GHC.Num.Natural(Natural) import GHC.Show(Show(..), appPrec, appPrec1, showParen, showString) import GHC.Read(Read(..)) import GHC.Prim(Proxy#) +import Data.Either(Either(..)) import Data.Maybe(Maybe(..)) import Data.Proxy (Proxy(..)) import Data.Type.Coercion (Coercion(..), TestCoercion(..)) @@ -239,6 +242,73 @@ sameNat :: forall a b proxy1 proxy2. proxy1 a -> proxy2 b -> Maybe (a :~: b) sameNat _ _ = testEquality (natSing @a) (natSing @b) +-- | We either get evidence that this function was instantiated with the +-- same type-level numbers, or that the type-level numbers are distinct. +-- +-- @since 4.19.0.0 +decideNat :: forall a b proxy1 proxy2. + (KnownNat a, KnownNat b) => + proxy1 a -> proxy2 b -> Either (a :~: b -> Void) (a :~: b) +decideNat _ _ = decNat (natSing @a) (natSing @b) + +-- Not exported: See [Not exported decNat, decSymbol and decChar] +decNat :: SNat a -> SNat b -> Either (a :~: b -> Void) (a :~: b) +decNat (UnsafeSNat x) (UnsafeSNat y) + | x == y = Right (unsafeCoerce Refl) + | otherwise = Left (\Refl -> errorWithoutStackTrace ("decideNat: Impossible equality proof " ++ show x ++ " :~: " ++ show y)) + +{- +Note [Not exported decNat, decSymbol and decChar] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The decNat, decSymbol and decChar are not (yet) exported. + +There are two development paths: +1. export them. +2. Add `decideEquality :: f a -> f b -> Either (a :~: b -> Void) (a :~: b)` + to the `Data.Type.Equality.TestEquality` typeclass. + +The second option looks nicer given the current base API: +there aren't `eqNat :: SNat a -> SNat b -> Maybe (a :~: b)` like functions, +they are abstracted by `TestEquality` typeclass. + +Also TestEquality class has a law that testEquality result +should be Just Refl iff the types applied to are equal: + +testEquality (x :: f a) (y :: f b) = Just Refl <=> a = b + +As consequence we have that testEquality should be Nothing +iff the types applied are inequal: + +testEquality (x :: f a) (y :: f b) = Nothing <=> a /= b + +And the decideEquality would enforce that. + +However, adding a new method is a breaking change, +as default implementation cannot be (safely) provided. +Also there are unlawful instances of `TestEquality` out there, +(e.g. https://hackage.haskell.org/package/parameterized-utils Index instance + https://hackage.haskell.org/package/witness various types) +which makes adding unsafe default implementation a bad idea. + +Adding own typeclass: + +class TestEquality f => DecideEquality f where + decideEquality :: f a -> f b -> Either (a :~: b -> Void) (a :~: b) + +is bad design, as `TestEquality` already implies that it should be possible. +In other words, every f with (lawful) `TestEquality` instance should have +`DecideEquality` instance as well. + +We hold on doing either 1. or 2. yet, as doing 2. is "harder", +but if it is done eventually, doing 1. is pointless. +In other words the paths can be thought as mutually exclusive. + +Fortunately the dec* functions can be simulated using decide* variants +if needed, so there is no hurry to commit to either development paths. + +-} + -- | Like 'sameNat', but if the numbers aren't equal, this additionally -- provides proof of LT or GT. -- @@ -318,9 +388,9 @@ instance Show (SNat n) where -- | @since 4.18.0.0 instance TestEquality SNat where - testEquality (UnsafeSNat x) (UnsafeSNat y) - | x == y = Just (unsafeCoerce Refl) - | otherwise = Nothing + testEquality a b = case decNat a b of + Right x -> Just x + Left _ -> Nothing -- | @since 4.18.0.0 instance TestCoercion SNat where ===================================== libraries/base/Type/Reflection.hs ===================================== @@ -44,6 +44,7 @@ module Type.Reflection , I.typeRepTyCon , I.rnfTypeRep , I.eqTypeRep + , I.decTypeRep , I.typeRepKind , I.splitApps ===================================== libraries/base/changelog.md ===================================== @@ -9,6 +9,8 @@ * Add INLINABLE pragmas to `generic*` functions in Data.OldList ([CLC proposal #129](https://github.com/haskell/core-libraries-committee/issues/130)) * Export `getSolo` from `Data.Tuple`. ([CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113)) + * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. + ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) ## 4.18.0.0 *TBA* ===================================== testsuite/tests/ghci/scripts/T9181.stdout ===================================== @@ -48,6 +48,20 @@ GHC.TypeLits.cmpChar :: GHC.TypeLits.cmpSymbol :: (GHC.TypeLits.KnownSymbol a, GHC.TypeLits.KnownSymbol b) => proxy1 a -> proxy2 b -> Data.Type.Ord.OrderingI a b +GHC.TypeLits.decideChar :: + (GHC.TypeLits.KnownChar a, GHC.TypeLits.KnownChar b) => + proxy1 a + -> proxy2 b + -> Either + ((a Data.Type.Equality.:~: b) -> GHC.Base.Void) + (a Data.Type.Equality.:~: b) +GHC.TypeLits.decideSymbol :: + (GHC.TypeLits.KnownSymbol a, GHC.TypeLits.KnownSymbol b) => + proxy1 a + -> proxy2 b + -> Either + ((a Data.Type.Equality.:~: b) -> GHC.Base.Void) + (a Data.Type.Equality.:~: b) GHC.TypeLits.fromSChar :: GHC.TypeLits.SChar c -> Char GHC.TypeLits.fromSNat :: GHC.TypeNats.SNat n -> Integer GHC.TypeLits.fromSSymbol :: GHC.TypeLits.SSymbol s -> String @@ -172,6 +186,13 @@ type family (GHC.TypeNats.^) a b GHC.TypeNats.cmpNat :: (GHC.TypeNats.KnownNat a, GHC.TypeNats.KnownNat b) => proxy1 a -> proxy2 b -> Data.Type.Ord.OrderingI a b +GHC.TypeNats.decideNat :: + (GHC.TypeNats.KnownNat a, GHC.TypeNats.KnownNat b) => + proxy1 a + -> proxy2 b + -> Either + ((a Data.Type.Equality.:~: b) -> GHC.Base.Void) + (a Data.Type.Equality.:~: b) GHC.TypeNats.sameNat :: (GHC.TypeNats.KnownNat a, GHC.TypeNats.KnownNat b) => proxy1 a -> proxy2 b -> Maybe (a Data.Type.Equality.:~: b) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/858f34d5270936ff565880ed3ff244a0ab5f3987 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/858f34d5270936ff565880ed3ff244a0ab5f3987 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 4 06:18:40 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 04 Mar 2023 01:18:40 -0500 Subject: [Git][ghc/ghc][master] Add test for T22793 Message-ID: <6402e2c037599_3ab52b29027b686194d9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - 3 changed files: - + testsuite/tests/polykinds/T22793.hs - + testsuite/tests/polykinds/T22793.stderr - testsuite/tests/polykinds/all.T Changes: ===================================== testsuite/tests/polykinds/T22793.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module T22793 where + +import Data.Kind + +type Foo :: forall k. k -> k -> Constraint + +class Foo s a + +bob :: forall {k1} {ks} {ka} q (p :: k1 -> q -> Type) + (f :: ka -> q) (s :: ks) (t :: ks) + (a :: ka) (b :: ka). Foo s a + => p a (f b) -> p s (f t) +bob f = undefined ===================================== testsuite/tests/polykinds/T22793.stderr ===================================== @@ -0,0 +1,44 @@ + +T22793.hs:15:42: error: [GHC-25897] + • Couldn't match kind ‘ka’ with ‘k1’ + Expected kind ‘ks’, but ‘a’ has kind ‘ka’ + ‘ka’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:26-27 + ‘k1’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:16-17 + • In the second argument of ‘Foo’, namely ‘a’ + In the type signature: + bob :: forall {k1} + {ks} + {ka} + q + (p :: k1 -> q -> Type) + (f :: ka -> q) + (s :: ks) + (t :: ks) + (a :: ka) + (b :: ka). Foo s a => p a (f b) -> p s (f t) + +T22793.hs:16:11: error: [GHC-25897] + • Couldn't match kind ‘ks’ with ‘k1’ + Expected kind ‘k1’, but ‘a’ has kind ‘ka’ + ‘ks’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:21-22 + ‘k1’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:16-17 + • In the first argument of ‘p’, namely ‘a’ + In the type signature: + bob :: forall {k1} + {ks} + {ka} + q + (p :: k1 -> q -> Type) + (f :: ka -> q) + (s :: ks) + (t :: ks) + (a :: ka) + (b :: ka). Foo s a => p a (f b) -> p s (f t) ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -243,3 +243,4 @@ test('T22379a', normal, compile, ['']) test('T22379b', normal, compile, ['']) test('T22743', normal, compile_fail, ['']) test('T22742', normal, compile_fail, ['']) +test('T22793', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf43ba9215a726039ace7bac37c0a223a912d998 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf43ba9215a726039ace7bac37c0a223a912d998 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 4 09:28:08 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 04 Mar 2023 04:28:08 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T23070 Message-ID: <64030f282f37_3ab52b2c57f7d46336f4@gitlab.mail> Simon Peyton Jones pushed new branch wip/T23070 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23070 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 4 10:21:07 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 04 Mar 2023 05:21:07 -0500 Subject: [Git][ghc/ghc][wip/T23070] Wibbles Message-ID: <64031b93e3114_3ab52b2d5509b06409b@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070 at Glasgow Haskell Compiler / GHC Commits: 8357a7db by Simon Peyton Jones at 2023-03-04T10:22:12+00:00 Wibbles - - - - - 2 changed files: - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs Changes: ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -39,7 +39,6 @@ import GHC.Driver.Session import qualified GHC.LanguageExtensions as LangExt -import Data.List( deleteFirstsBy ) import Data.Maybe ( listToMaybe, mapMaybe ) ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -244,7 +244,7 @@ can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } ---------------------------- --- Look for a canonical LHS. See Note [Canonical LHS]. +-- Look for a canonical LHS. -- Only rewritten types end up below here. ---------------------------- @@ -2497,10 +2497,6 @@ We avoid this problem by orienting the resulting given so that the unification variable is on the left (note that alternatively we could attempt to enforce this at canonicalization). -See also Note [No touchables as FunEq RHS] in GHC.Tc.Solver.Monad; avoiding -double unifications is the main reason we disallow touchable -unification variables as RHS of type family equations: F xis ~ alpha. - Note [Do not unify representational equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider [W] alpha ~R# b View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8357a7db55ced7e9f8f42c7ab77bc1408b0599a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8357a7db55ced7e9f8f42c7ab77bc1408b0599a1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 4 21:52:12 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 04 Mar 2023 16:52:12 -0500 Subject: [Git][ghc/ghc][wip/T23070] More wibbles Message-ID: <6403bd8c1f50c_3ab52b38100ae4664290@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070 at Glasgow Haskell Compiler / GHC Commits: 925bb0f1 by Simon Peyton Jones at 2023-03-04T21:53:12+00:00 More wibbles - - - - - 2 changed files: - compiler/GHC/Tc/Solver/Equality.hs - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -241,6 +241,7 @@ can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2 do { (redn1@(Reduction _ xi1), rewriters1) <- rewrite ev ps_ty1 ; (redn2@(Reduction _ xi2), rewriters2) <- rewrite ev ps_ty2 ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 + ; traceTcS "can_eq_nc: go round again" (ppr new_ev $$ ppr xi1 $$ ppr xi2) ; can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 } ---------------------------- @@ -274,8 +275,8 @@ can_eq_nc' True _rdr_env _envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2 can_eq_nc' True _rdr_env _envs ev eq_rel _ ps_ty1 _ ps_ty2 = do { traceTcS "can_eq_nc' catch-all case" (ppr ps_ty1 $$ ppr ps_ty2) ; case eq_rel of -- See Note [Unsolved equalities] - ReprEq -> continueWith (mkIrredCt ReprEqReason ev) - NomEq -> continueWith (mkIrredCt ShapeMismatchReason ev) } + ReprEq -> finishIrredEquality ReprEqReason ev + NomEq -> finishIrredEquality ShapeMismatchReason ev } -- No need to call canEqFailure/canEqHardFailure because they -- rewrite, and the types involved here are already rewritten @@ -731,7 +732,7 @@ canTyConApp ev eq_rel tc1 tys1 tc2 tys2 -- See Note [Skolem abstract data] in GHC.Core.Tycon | tyConSkolem tc1 || tyConSkolem tc2 = do { traceTcS "canTyConApp: skolem abstract" (ppr tc1 $$ ppr tc2) - ; continueWith (mkIrredCt AbstractTyConReason ev) } + ; finishIrredEquality AbstractTyConReason ev } -- Fail straight away for better error messages -- See Note [Use canEqFailure in canDecomposableTyConApp] @@ -1706,7 +1707,9 @@ canEqCanLHSFinish ev eq_rel swapped lhs rhs NomEq -> result0 ReprEq -> cterSetOccursCheckSoluble result0 - reason = NonCanonicalReason result + non_canonical_result what + = do { traceTcS ("canEqCanLHSFinish: " ++ what) (ppr lhs $$ ppr rhs) + ; finishIrredEquality (NonCanonicalReason result) new_ev } ; ics <- getInertCans ; if cterHasNoProblem result @@ -1718,22 +1721,17 @@ canEqCanLHSFinish ev eq_rel swapped lhs rhs -- See Note [Type equality cycles]; -- returning Nothing is the vastly common case ; case m_stuff of - { Nothing -> - do { traceTcS "canEqCanLHSFinish can't make a canonical" - (ppr lhs $$ ppr rhs) - ; continueWith (mkIrredCt reason new_ev) } + { Nothing -> non_canonical_result "Can't make canonical" + ; Just rhs_redn@(Reduction _ new_rhs) -> do { traceTcS "canEqCanLHSFinish breaking a cycle" $ - ppr lhs $$ ppr rhs - ; traceTcS "new RHS:" (ppr new_rhs) + vcat [ text "lhs:" <+> ppr lhs, text "rhs:" <+> ppr rhs + , text "new_rhs:" <+> ppr new_rhs ] -- This check is Detail (1) in the Note ; if cterHasOccursCheck (checkTypeEq lhs new_rhs) - - then do { traceTcS "Note [Type equality cycles] Detail (1)" - (ppr new_rhs) - ; continueWith (mkIrredCt reason new_ev) } + then non_canonical_result "Note [Type equality cycles] Detail (1)" else do { -- See Detail (6) of Note [Type equality cycles] new_new_ev <- rewriteEqEvidence emptyRewriterSet @@ -2365,7 +2363,6 @@ interactEq inerts downgradeRole (eqRelRole eq_rel) (ctEvRole ev_i) (ctEvCoercion ev_i)) - ; stopWith ev "Solved from inert" } | otherwise @@ -2374,7 +2371,7 @@ interactEq inerts TyFamLHS tc args -> do { improveLocalFunEqs inerts tc args work_item ; improveTopFunEqs tc args work_item - ; doTopReactEq work_item } + ; finishEqCt work_item } inertsCanDischarge :: InertCans -> EqCt @@ -2438,7 +2435,7 @@ tryToSolveByUnification tv | ReprEq <- eq_rel -- See Note [Do not unify representational equalities] = do { traceTcS "Not unifying representational equality" (ppr work_item) - ; doTopReactEq work_item } + ; dont_unify } | otherwise = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv rhs @@ -2446,7 +2443,7 @@ tryToSolveByUnification tv , ppr is_touchable ]) ; case is_touchable of - Untouchable -> doTopReactEq work_item + Untouchable -> dont_unify -- For the latter two cases see Note [Solve by unification] TouchableSameLevel -> solveByUnification ev tv rhs @@ -2455,6 +2452,8 @@ tryToSolveByUnification tv -> do { wrapTcS $ mapM_ (promoteMetaTyVarTo tv_lvl) free_metas ; setUnificationFlag tv_lvl ; solveByUnification ev tv rhs } } + where + dont_unify = finishEqCt work_item solveByUnification :: CtEvidence -> TcTyVar -> Xi -> TcS (StopOrContinue Ct) -- Solve with the identity coercion @@ -2544,7 +2543,7 @@ at the ambient level because of the kick-out mechanism.) {-******************************************************************** * * - Top-level reaction for equality constraints + Final wrap-up for equalities * * ********************************************************************-} @@ -2561,22 +2560,40 @@ See -} -------------------- -doTopReactEq :: EqCt -> TcS (StopOrContinue Ct) --- See GHC.Tc.Solver.Canonical --- Note [Equality superclasses in quantified constraints] -doTopReactEq work_item@(EqCt { eq_ev = ev, eq_lhs = lhs, eq_rhs = rhs, eq_eq_rel = eq_rel }) - -- See Note [Looking up primitive equalities in quantified constraints] - | Just (cls, tys) <- boxEqPred eq_rel (canEqLHSType lhs) rhs +finishIrredEquality :: CtIrredReason -> CtEvidence -> TcS (StopOrContinue Ct) +finishIrredEquality reason ev + | EqPred eq_rel t1 t2 <- classifyPredType (ctEvPred ev) + = final_qci_check (mkIrredCt reason ev) eq_rel t1 t2 + | otherwise -- All the calls come from in this module, where we deal + -- only with equalities. We could pass eq_rel, t1, t2 as arguments + -- but it's not a hot path, and this is simple and robust + = pprPanic "finishIrredEquality" (ppr ev) + +-------------------- +finishEqCt :: EqCt -> TcS (StopOrContinue Ct) +finishEqCt work_item@(EqCt { eq_lhs = lhs, eq_rhs = rhs, eq_eq_rel = eq_rel }) + = final_qci_check (CEqCan work_item) eq_rel (canEqLHSType lhs) rhs + +-------------------- +final_qci_check :: Ct -> EqRel -> TcType -> TcType -> TcS (StopOrContinue Ct) +-- The "final QCI check" checks to see if we have +-- [W] t1 ~# t2 +-- and a Given quantified contraint like (forall a b. blah => a :~: b) +-- Why? See Note [Looking up primitive equalities in quantified constraints] +final_qci_check work_ct eq_rel lhs rhs + | isWanted ev + , Just (cls, tys) <- boxEqPred eq_rel lhs rhs = do { res <- matchLocalInst (mkClassPred cls tys) loc ; case res of OneInst { cir_mk_ev = mk_ev } - -> chooseInstance (CEqCan work_item) + -> chooseInstance work_ct (res { cir_mk_ev = mk_eq_ev cls tys mk_ev }) - _ -> continueWith (CEqCan work_item) } + _ -> continueWith work_ct } | otherwise - = continueWith (CEqCan work_item) + = continueWith work_ct where + ev = ctEvidence work_ct loc = ctEvLoc ev mk_eq_ev cls tys mk_ev evs @@ -2584,7 +2601,7 @@ doTopReactEq work_item@(EqCt { eq_ev = ev, eq_lhs = lhs, eq_rhs = rhs, eq_eq_rel = assert (null rest) $ case (mk_ev evs) of EvExpr e -> EvExpr (Var sc_id `mkTyApps` tys `App` e) ev -> pprPanic "mk_eq_ev" (ppr ev) - | otherwise = pprPanic "doTopReactEq" (ppr work_item) + | otherwise = pprPanic "finishEqCt" (ppr work_ct) {- ********************************************************************** ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -1,63 +1,61 @@ -ref compiler/GHC/Core/Coercion/Axiom.hs:461:2: Note [RoughMap and rm_empty] -ref compiler/GHC/Core/Opt/OccurAnal.hs:857:15: Note [Loop breaking] -ref compiler/GHC/Core/Opt/SetLevels.hs:1580:30: Note [Top level scope] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2675:13: Note [Case binder next] -ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:3854:8: Note [Lambda-bound unfoldings] -ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1257:37: Note [Gentle mode] -ref compiler/GHC/Core/Opt/Specialise.hs:1623:28: Note [Arity decrease] -ref compiler/GHC/Core/TyCo/Rep.hs:1748:31: Note [What prevents a constraint from floating] -ref compiler/GHC/Driver/Main.hs:1641:34: Note [simpleTidyPgm - mkBootModDetailsTc] -ref compiler/GHC/Driver/Session.hs:3961:49: Note [Eta-reduction in -O0] +ref compiler/GHC/Core/Coercion/Axiom.hs:463:2: Note [RoughMap and rm_empty] +ref compiler/GHC/Core/Opt/OccurAnal.hs:983:7: Note [Loop breaking] +ref compiler/GHC/Core/Opt/SetLevels.hs:1574:30: Note [Top level scope] +ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:2825:13: Note [Case binder next] +ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4009:8: Note [Lambda-bound unfoldings] +ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode] +ref compiler/GHC/Core/Opt/Specialise.hs:1790:28: Note [Arity decrease] +ref compiler/GHC/Core/TyCo/Rep.hs:1556:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Driver/Main.hs:1761:34: Note [simpleTidyPgm - mkBootModDetailsTc] +ref compiler/GHC/Driver/Session.hs:3976:49: Note [Eta-reduction in -O0] ref compiler/GHC/Hs/Expr.hs:191:63: Note [Pending Splices] -ref compiler/GHC/Hs/Expr.hs:1704:87: Note [Lifecycle of a splice] -ref compiler/GHC/Hs/Expr.hs:1740:7: Note [Pending Splices] -ref compiler/GHC/Hs/Extension.hs:144:5: Note [Strict argument type constraints] +ref compiler/GHC/Hs/Expr.hs:1706:87: Note [Lifecycle of a splice] +ref compiler/GHC/Hs/Expr.hs:1742:7: Note [Pending Splices] +ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constraints] ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] -ref compiler/GHC/HsToCore/Pmc/Solver.hs:854:20: Note [COMPLETE sets on data families] -ref compiler/GHC/HsToCore/Quote.hs:1460:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/Rename/Pat.hs:888:29: Note [Disambiguating record fields] -ref compiler/GHC/Stg/Unarise.hs:313:32: Note [Renaming during unarisation] +ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] +ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] +ref compiler/GHC/Rename/Pat.hs:890:29: Note [Disambiguating record fields] +ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] -ref compiler/GHC/StgToCmm/Expr.hs:584:4: Note [case on bool] -ref compiler/GHC/StgToCmm/Expr.hs:848:3: Note [alg-alt heap check] -ref compiler/GHC/Tc/Gen/Expr.hs:1207:23: Note [Disambiguating record fields] -ref compiler/GHC/Tc/Gen/Expr.hs:1422:7: Note [Disambiguating record fields] -ref compiler/GHC/Tc/Gen/Expr.hs:1525:11: Note [Deprecating ambiguous fields] -ref compiler/GHC/Tc/Gen/HsType.hs:551:56: Note [Skolem escape prevention] -ref compiler/GHC/Tc/Gen/HsType.hs:2619:7: Note [Matching a kind signature with a declaration] -ref compiler/GHC/Tc/Gen/Pat.hs:171:20: Note [Typing patterns in pattern bindings] -ref compiler/GHC/Tc/Gen/Pat.hs:1101:7: Note [Matching polytyped patterns] -ref compiler/GHC/Tc/Gen/Sig.hs:79:10: Note [Overview of type signatures] +ref compiler/GHC/StgToCmm/Expr.hs:585:4: Note [case on bool] +ref compiler/GHC/StgToCmm/Expr.hs:853:3: Note [alg-alt heap check] +ref compiler/GHC/Tc/Gen/Expr.hs:1212:23: Note [Disambiguating record fields] +ref compiler/GHC/Tc/Gen/Expr.hs:1427:7: Note [Disambiguating record fields] +ref compiler/GHC/Tc/Gen/Expr.hs:1530:11: Note [Deprecating ambiguous fields] +ref compiler/GHC/Tc/Gen/HsType.hs:557:56: Note [Skolem escape prevention] +ref compiler/GHC/Tc/Gen/HsType.hs:2622:7: Note [Matching a kind signature with a declaration] +ref compiler/GHC/Tc/Gen/Pat.hs:176:20: Note [Typing patterns in pattern bindings] +ref compiler/GHC/Tc/Gen/Pat.hs:1127:7: Note [Matching polytyped patterns] +ref compiler/GHC/Tc/Gen/Sig.hs:81:10: Note [Overview of type signatures] ref compiler/GHC/Tc/Gen/Splice.hs:359:16: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Gen/Splice.hs:534:35: Note [PendingRnSplice] ref compiler/GHC/Tc/Gen/Splice.hs:658:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/Tc/Gen/Splice.hs:897:11: Note [How brackets and nested splices are handled] -ref compiler/GHC/Tc/Instance/Family.hs:515:35: Note [Constrained family instances] -ref compiler/GHC/Tc/Module.hs:704:15: Note [Extra dependencies from .hs-boot files] -ref compiler/GHC/Tc/Solver/Canonical.hs:1087:33: Note [Canonical LHS] -ref compiler/GHC/Tc/Solver/Interact.hs:1611:9: Note [No touchables as FunEq RHS] -ref compiler/GHC/Tc/Solver/Rewrite.hs:988:7: Note [Stability of rewriting] -ref compiler/GHC/Tc/TyCl.hs:1106:6: Note [Unification variables need fresh Names] -ref compiler/GHC/Tc/Types.hs:703:33: Note [Extra dependencies from .hs-boot files] -ref compiler/GHC/Tc/Types.hs:1434:47: Note [Care with plugin imports] -ref compiler/GHC/Tc/Types/Constraint.hs:253:34: Note [NonCanonical Semantics] -ref compiler/GHC/Types/Demand.hs:308:25: Note [Preserving Boxity of results is rarely a win] -ref compiler/GHC/Unit/Module/Deps.hs:82:13: Note [Structure of dep_boot_mods] -ref compiler/GHC/Utils/Monad.hs:391:34: Note [multiShotIO] -ref compiler/Language/Haskell/Syntax/Binds.hs:204:31: Note [fun_id in Match] -ref compiler/Language/Haskell/Syntax/Pat.hs:336:12: Note [Disambiguating record fields] -ref configure.ac:212:10: Note [Linking ghc-bin against threaded stage0 RTS] +ref compiler/GHC/Tc/Gen/Splice.hs:891:11: Note [How brackets and nested splices are handled] +ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] +ref compiler/GHC/Tc/Module.hs:708:15: Note [Extra dependencies from .hs-boot files] +ref compiler/GHC/Tc/Solver/Rewrite.hs:1008:7: Note [Stability of rewriting] +ref compiler/GHC/Tc/TyCl.hs:1119:6: Note [Unification variables need fresh Names] +ref compiler/GHC/Tc/Types.hs:697:33: Note [Extra dependencies from .hs-boot files] +ref compiler/GHC/Tc/Types.hs:1428:47: Note [Care with plugin imports] +ref compiler/GHC/Tc/Types/Constraint.hs:223:34: Note [NonCanonical Semantics] +ref compiler/GHC/Types/Demand.hs:306:25: Note [Preserving Boxity of results is rarely a win] +ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods] +ref compiler/GHC/Utils/Monad.hs:400:34: Note [multiShotIO] +ref compiler/Language/Haskell/Syntax/Binds.hs:200:31: Note [fun_id in Match] +ref compiler/Language/Haskell/Syntax/Pat.hs:356:12: Note [Disambiguating record fields] +ref configure.ac:210:10: Note [Linking ghc-bin against threaded stage0 RTS] ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders] -ref hadrian/src/Expression.hs:130:30: Note [Linking ghc-bin against threaded stage0 RTS] +ref hadrian/src/Expression.hs:134:30: Note [Linking ghc-bin against threaded stage0 RTS] ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] -ref testsuite/config/ghc:243:10: Note [WayFlags] -ref testsuite/driver/testlib.py:153:10: Note [Why is there no stage1 setup function?] -ref testsuite/driver/testlib.py:157:2: Note [Why is there no stage1 setup function?] +ref testsuite/config/ghc:272:10: Note [WayFlags] +ref testsuite/driver/testlib.py:160:10: Note [Why is there no stage1 setup function?] +ref testsuite/driver/testlib.py:164:2: Note [Why is there no stage1 setup function?] ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] ref testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs:30:27: Note [Extra TcS Untouchables] -ref testsuite/tests/perf/should_run/all.T:3:6: Note [Solving from instances when interacting Dicts] +ref testsuite/tests/perf/should_run/all.T:8:6: Note [Solving from instances when interacting Dicts] ref testsuite/tests/polykinds/CuskFam.hs:16:11: Note [Unifying implicit CUSK variables] ref testsuite/tests/simplCore/should_compile/T5776.hs:16:7: Note [Simplifying RULE lhs constraints] ref testsuite/tests/simplCore/should_compile/simpl018.hs:3:7: Note [Float coercions] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/925bb0f1f085e857b4b87689801fe2ff0d28fa12 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/925bb0f1f085e857b4b87689801fe2ff0d28fa12 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 4 22:36:41 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 04 Mar 2023 17:36:41 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22328 Message-ID: <6403c7f992ecf_3ab52b390007ec6667b1@gitlab.mail> Simon Peyton Jones pushed new branch wip/T22328 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22328 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 4 23:27:40 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Sat, 04 Mar 2023 18:27:40 -0500 Subject: [Git][ghc/ghc][wip/T21909] 15 commits: Don't suppress *all* Wanteds Message-ID: <6403d3ec31c0_3ab52b39c5c8ec6756d9@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - f2245299 by Apoorv Ingle at 2023-03-04T17:27:24-06:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [SimplifyInfer and UndecidableSuperClasses] - - - - - 30 changed files: - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/expected-undocumented-flags.txt - libraries/base/Data/Tuple.hs - libraries/base/Data/Typeable.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/Type/Reflection.hs - libraries/base/changelog.md - libraries/ghc-prim/GHC/Tuple/Prim.hs - rts/Capability.c - rts/Capability.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f89fefc53ff33f9d478889552bbdbc2bd6fb5b3a...f22452995787f8605c22de7b9dcdcbf2768b1e22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f89fefc53ff33f9d478889552bbdbc2bd6fb5b3a...f22452995787f8605c22de7b9dcdcbf2768b1e22 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 4 23:34:19 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Sat, 04 Mar 2023 18:34:19 -0500 Subject: [Git][ghc/ghc][wip/T21909] Constraint simplification loop now depends on `ExpansionFuel` Message-ID: <6403d57b3eb24_3ab52b39e7938c6813d8@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: a81e30f9 by Apoorv Ingle at 2023-03-04T17:34:03-06:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [SimplifyInfer and UndecidableSuperClasses] - - - - - 11 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - docs/users_guide/expected-undocumented-flags.txt - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Class.hs ===================================== @@ -17,8 +17,8 @@ module GHC.Core.Class ( mkClass, mkAbstractClass, classTyVars, classArity, classKey, className, classATs, classATItems, classTyCon, classMethods, classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta, - classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, classHasFds, - isAbstractClass, + classHasSCs, classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, + classHasFds, isAbstractClass, ) where import GHC.Prelude @@ -295,6 +295,9 @@ classSCTheta (Class { classBody = ConcreteClass { cls_sc_theta = theta_stuff }}) = theta_stuff classSCTheta _ = [] +classHasSCs :: Class -> Bool +classHasSCs cls = not (null (classSCTheta cls)) + classTvsFds :: Class -> ([TyVar], [FunDep TyVar]) classTvsFds c = (classTyVars c, classFunDeps c) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -517,7 +517,15 @@ data DynFlags = DynFlags { reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver -- Typically only 1 is needed - + givensFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < solverIterations + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + qcsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] homeUnitId_ :: UnitId, -- ^ Target home unit-id homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations @@ -1148,6 +1156,9 @@ defaultDynFlags mySettings = mainFunIs = Nothing, reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, homeUnitId_ = mainUnitId, homeUnitInstanceOf_ = Nothing, @@ -2733,6 +2744,12 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n })) , make_ord_flag defFlag "fconstraint-solver-iterations" (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n })) + , make_ord_flag defFlag "fgivens-expansion-fuel" + (intSuffix (\n d -> d { givensFuel = n })) + , make_ord_flag defFlag "fwanteds-expansion-fuel" + (intSuffix (\n d -> d { wantedsFuel = n })) + , make_ord_flag defFlag "fqcs-expansion-fuel" + (intSuffix (\n d -> d { qcsFuel = n })) , (Deprecated, defFlag "fcontext-stack" (intSuffixM (\n d -> do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead" ===================================== compiler/GHC/Settings/Constants.hs ===================================== @@ -30,6 +30,27 @@ mAX_REDUCTION_DEPTH = 200 mAX_SOLVER_ITERATIONS :: Int mAX_SOLVER_ITERATIONS = 4 +-- | In case of loopy quantified costraints constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_QC_FUEL :: Int +mAX_QC_FUEL = 3 + +-- | In case of loopy wanted constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_GIVENS_FUEL +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_WANTEDS_FUEL :: Int +mAX_WANTEDS_FUEL = 1 + +-- | In case of loopy given constraints, +-- how many times should we allow superclass expansions +-- Should be less than max_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_GIVENS_FUEL :: Int +mAX_GIVENS_FUEL = 3 + wORD64_SIZE :: Int wORD64_SIZE = 8 ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2338,6 +2338,10 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set + ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given + , text "new_given" <+> ppr new_given + , text "pending_wanted" <+> ppr pending_wanted + , text "new_wanted" <+> ppr new_wanted ]) ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } -- (not (null pending_given)): see Note [Superclass iteration] @@ -2366,6 +2370,72 @@ superclasses. In that case we check whether the new Wanteds actually led to any new unifications, and iterate the implications only if so. -} +{- Note [Expanding Recursive Superclasses and ExpansionFuel] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the class declaration (T21909) + + class C [a] => C a where + foo :: a -> Int + +and suppose during type inference we obtain an implication constraint: + + forall a. C a => C [[a]] + +To solve this implication constraint, we first expand one layer of the superclass +of Given constraints, but not for Wanted constraints. +(See Note [Eagerly expand given superclasses] and Note [Why adding superclasses can help] +in GHC.Tc.Solver.Canonical.) We thus get: + + [G] g1 :: C a + [G] g2 :: C [a] -- new superclass layer from g1 + [W] w1 :: C [[a]] + +Now, we cannot solve `w1` directly from `g1` or `g2` as we may not have +any instances for C. So we expand a layer of superclasses of each Wanteds and Givens +that we haven't expanded yet. +This is done in `maybe_simplify_again`. And we get: + + [G] g1 :: C a + [G] g2 :: C [a] + [G] g3 :: C [[a]] -- new superclass layer from g2, can solve w1 + [W] w1 :: C [[a]] + [W] w2 :: C [[[a]]] -- new superclass layer from w1, not solvable + +Now, although we can solve `w1` using `g3` (obtained from expanding `g2`), +we have a new wanted constraint `w2` (obtained from expanding `w1`) that cannot be solved. +We thus make another go at solving in `maybe_simplify_again` by expanding more +layers of superclasses. This looping is futile as Givens will never be able to catch up with Wanteds. + +Side Note: We don't need to solve `w2`, as it is a superclass of `w1` +and we only expand it to expose any functional dependencies (see Note [The superclass story]) +But it is a wanted constraint, so we expand it even though ultimately we discard its evidence. + +Solution: Simply bound the maximum number of layers of expansion for +Givens and Wanteds, with ExpansionFuel. Give the Givens more fuel +(say 3 layers) than the Wanteds (say 1 layer). Now the Givens will +win. The Wanteds don't need much fuel: we are only expanding at all +to expose functional dependencies, and wantedFuel=1 means we will +expand a full recursive layer. If the superclass hierarchy is +non-recursive (the normal case) one layer is therefore full expansion. + +The default value for wantedFuel = Constants.max_WANTEDS_FUEL = 1. +The default value for givenFuel = Constants.max_GIVENS_FUEL = 3. +Both are configurable via the `-fgivens-fuel` and `-fwanteds-fuel` +compiler flags. + +There are two preconditions for the default fuel values: + (1) default givenFuel >= default wantedsFuel + (2) default givenFuel < solverIterations + +Precondition (1) ensures that we expand givens atleast as many times as we expand wanted constraints +preferably givenFuel > wantedsFuel to avoid issues like T21909 while +the precondition (2) ensures that we do not reach the solver iteration limit and fail with a +more meaningful error message + +This also applies for quantified constraints; see `-fqcs-fuel` compiler flag and `QCI.qci_pend_sc` field. +-} + + solveNestedImplications :: Bag Implication -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -59,7 +59,7 @@ import Control.Monad import Data.Maybe ( isJust, isNothing ) import Data.List ( zip4 ) import GHC.Types.Basic - +import GHC.Driver.Session ( givensFuel, wantedsFuel, qcsFuel ) import qualified Data.Semigroup as S import Data.Bifunctor ( bimap ) @@ -154,9 +154,13 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys doNotExpand } + -- doNotExpand: We have already expanded superclasses for /this/ dict + -- so set the fuel to doNotExpand to avoid repeating expansion | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -168,7 +172,7 @@ canClassNC ev cls tys -- and Note [Solving CallStack constraints] in GHC.Tc.Solver.Types = do { -- First we emit a new constraint that will capture the -- given CallStack. - ; let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) + let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) -- We change the origin to IPOccOrigin so -- this rule does not fire again. -- See Note [Overview of implicit CallStacks] @@ -182,14 +186,20 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys doNotExpand + -- doNotExpand: No superclasses for class CallStack + -- See invariants in CDictCan.cc_pend_sc } | otherwise - = canClass ev cls tys (has_scs cls) + = do { dflags <- getDynFlags + ; let fuel | classHasSCs cls = wantedsFuel dflags + | otherwise = doNotExpand + -- See Invariants in `CCDictCan.cc_pend_sc` + ; canClass ev cls tys fuel + } where - has_scs cls = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -206,7 +216,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -307,10 +317,11 @@ So here's the plan: 4. Go round to (2) again. This loop (2,3,4) is implemented in GHC.Tc.Solver.simpl_loop. -The cc_pend_sc flag in a CDictCan records whether the superclasses of +The cc_pend_sc field in a CDictCan records whether the superclasses of this constraint have been expanded. Specifically, in Step 3 we only -expand superclasses for constraints with cc_pend_sc set to true (i.e. -isPendingScDict holds). +expand superclasses for constraints with cc_pend_sc > 0 +(i.e. isPendingScDict holds). +See Note [Expanding Recursive Superclasses and ExpansionFuel] Why do we do this? Two reasons: @@ -337,7 +348,8 @@ our strategy. Consider f :: C a => a -> Bool f x = x==x Then canClassNC gets the [G] d1: C a constraint, and eager emits superclasses -G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its sc_pend flag set.) +G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its cc_pend_sc has pending +expansion fuel.) When processing d3 we find a match with d1 in the inert set, and we always keep the inert item (d1) if possible: see Note [Replacement vs keeping] in GHC.Tc.Solver.Interact. So d3 dies a quick, happy death. @@ -484,7 +496,6 @@ the sc_theta_ids at all. So our final construction is makeSuperClasses :: [Ct] -> TcS [Ct] -- Returns strict superclasses, transitively, see Note [The superclass story] --- See Note [The superclass story] -- The loop-breaking here follows Note [Expanding superclasses] in GHC.Tc.Utils.TcType -- Specifically, for an incoming (C t) constraint, we return all of (C t)'s -- superclasses, up to /and including/ the first repetition of C @@ -493,39 +504,45 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- class C [a] => D a -- makeSuperClasses (C x) will return (D x, C [x]) -- --- NB: the incoming constraints have had their cc_pend_sc flag already --- flipped to False, by isPendingScDict, so we are /obliged/ to at --- least produce the immediate superclasses +-- NB: the incoming constraint's superclass will consume a unit of fuel +-- Preconditions on `cts`: 1. They are either `CDictCan` or `CQuantCan` +-- 2. Their fuel (stored in cc_pend_sc or qci_pend_sc) is > 0 makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys - go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev [] [] cls tys + go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +-- Precondition: fuel > 0 +-- Postcondition: fuel for recursive superclass ct is one unit less than cls fuel +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses (consumeFuel fuel) (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +-- The caller of this function is supposed to perform fuel book keeping +-- Precondition: fuel >= 0 +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -543,7 +560,8 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; assertFuelPrecondition fuel + $ mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -604,7 +622,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -619,7 +637,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -634,46 +652,53 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +-- Precondition: fuel >= 0 +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = assertFuelPrecondition fuel $ + mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +-- Precondition: fuel >= 0 +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) - ; return [this_ct] } -- cc_pend_sc of this_ct = True + ; assertFuelPrecondition fuel $ return [mk_this_ct fuel] } + -- cc_pend_sc of returning ct = fuel | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys - ; return (this_ct : sc_cts) } - -- cc_pend_sc of this_ct = False + ; sc_cts <- assertFuelPrecondition fuel $ + mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys + ; return (mk_this_ct doNotExpand : sc_cts) } + -- doNotExpand: we have expanded this cls's superclasses, so + -- exhaust the associated constraint's fuel, + -- to avoid duplicate work where cls_nm = className cls loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm - - this_ct | null tvs, null theta - = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } - -- NB: If there is a loop, we cut off, so we have not - -- added the superclasses, hence cc_pend_sc = True - | otherwise - = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys - , qci_ev = ev - , qci_pend_sc = loop_found }) + mk_this_ct :: ExpansionFuel -> Ct + mk_this_ct fuel | null tvs, null theta + = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys + , cc_pend_sc = fuel } + -- NB: If there is a loop, we cut off, so we have not + -- added the superclasses, hence cc_pend_sc = fuel + | otherwise + = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys + , qci_ev = ev + , qci_pend_sc = fuel }) {- Note [Equality superclasses in quantified constraints] @@ -828,19 +853,28 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev tvs theta cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canForAll ev False } + ; canForAll ev doNotExpand } + -- doNotExpand: as we have already (eagerly) expanded superclasses for this class | otherwise - = canForAll ev (isJust cls_pred_tys_maybe) - + = do { dflags <- getDynFlags + ; let fuel | Just (cls, _) <- cls_pred_tys_maybe + , classHasSCs cls = qcsFuel dflags + -- See invariants (a) and (b) in QCI.qci_pend_sc + -- qcsFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + -- See Note [Quantified constraints] + | otherwise = doNotExpand + ; canForAll ev fuel } where cls_pred_tys_maybe = getClassPredTys_maybe pred -canForAll :: CtEvidence -> Bool -> TcS (StopOrContinue Ct) +canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) -- We have a constraint (forall as. blah => C tys) -canForAll ev pend_sc +canForAll ev fuel = do { -- First rewrite it to apply the current substitution let pred = ctEvPred ev ; (redn, rewriters) <- rewrite ev pred @@ -850,14 +884,14 @@ canForAll ev pend_sc -- (It takes a lot less code to rewrite before decomposing.) ; case classifyPredType (ctEvPred new_ev) of ForAllPred tvs theta pred - -> solveForAll new_ev tvs theta pred pend_sc + -> solveForAll new_ev tvs theta pred fuel _ -> pprPanic "canForAll" (ppr new_ev) } } -solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> Bool +solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel -> TcS (StopOrContinue Ct) solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) - tvs theta pred _pend_sc + tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] setLclEnv (ctLocEnv loc) $ -- This setLclEnv is important: the emitImplicationTcS uses that @@ -903,12 +937,12 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo _ -> pSizeType pred -- See Note [Solving a Given forall-constraint] -solveForAll ev@(CtGiven {}) tvs _theta pred pend_sc +solveForAll ev@(CtGiven {}) tvs _theta pred fuel = do { addInertForAll qci ; stopWith ev "Given forall-constraint" } where qci = QCI { qci_ev = ev, qci_tvs = tvs - , qci_pred = pred, qci_pend_sc = pend_sc } + , qci_pred = pred, qci_pend_sc = fuel } {- Note [Solving a Wanted forall-constraint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -513,10 +513,13 @@ getInertGivens ; return (filter isGivenCt all_cts) } getPendingGivenScs :: TcS [Ct] --- Find all inert Given dictionaries, or quantified constraints, --- whose cc_pend_sc flag is True --- and that belong to the current level --- Set their cc_pend_sc flag to False in the inert set, and return that Ct +-- Find all inert Given dictionaries, or quantified constraints, such that +-- 1. cc_pend_sc flag has fuel strictly > 0 +-- 2. belongs to the current level +-- For each such dictionary: +-- * Return it (with unmodified cc_pend_sc) in sc_pending +-- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand +-- to record that we have expanded superclasses for this dict getPendingGivenScs = do { lvl <- getTcLevel ; updRetInertCans (get_sc_pending lvl) } @@ -530,29 +533,33 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) sc_pending = sc_pend_insts ++ sc_pend_dicts sc_pend_dicts = foldDicts get_pending dicts [] - dicts' = foldr add dicts sc_pend_dicts + dicts' = foldr exhaustAndAdd dicts sc_pend_dicts (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts - | Just dict' <- pendingScDict_maybe dict + | isPendingScDict dict , belongs_to_this_level (ctEvidence dict) - = dict' : dicts + = dict : dicts | otherwise = dicts - add :: Ct -> DictMap Ct -> DictMap Ct - add ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts - = addDict dicts cls tys ct - add ct _ = pprPanic "getPendingScDicts" (ppr ct) + exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct + exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts + -- exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) + exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) get_pending_inst cts qci@(QCI { qci_ev = ev }) | Just qci' <- pendingScInst_maybe qci , belongs_to_this_level ev - = (CQuantCan qci' : cts, qci') + = (CQuantCan qci : cts, qci') + -- qci' have their fuel exhausted + -- we don't want to expand these constraints again + -- qci is expanded | otherwise = (cts, qci) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,6 +11,8 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, + ExpansionFuel, doNotExpand, consumeFuel, pendingFuel, + assertFuelPrecondition, assertFuelPreconditionStrict, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -138,8 +140,6 @@ import Data.Word ( Word8 ) import Data.List ( intersperse ) - - {- ************************************************************************ * * @@ -191,6 +191,37 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- Invariant: ExpansionFuel should always be >= 0 +-- see Note [Expanding Recursive Superclasses and ExpansionFuel] +type ExpansionFuel = Int + +-- | Do not expand superclasses any further +doNotExpand :: ExpansionFuel +doNotExpand = 0 + +-- | Consumes one unit of fuel. +-- Precondition: fuel > 0 +consumeFuel :: ExpansionFuel -> ExpansionFuel +consumeFuel fuel = assertFuelPreconditionStrict fuel $ fuel - 1 + +-- | Returns True if we have any fuel left for superclass expansion +pendingFuel :: ExpansionFuel -> Bool +pendingFuel n = n > 0 + +insufficientFuelError :: SDoc +insufficientFuelError = text "Superclass expansion fuel should be > 0" + +-- | asserts if fuel is non-negative +assertFuelPrecondition :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPrecondition #-} +assertFuelPrecondition fuel = assertPpr (fuel >= 0) insufficientFuelError + +-- | asserts if fuel is strictly greater than 0 +assertFuelPreconditionStrict :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPreconditionStrict #-} +assertFuelPreconditionStrict fuel = assertPpr (pendingFuel fuel) insufficientFuelError + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,11 +230,12 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those - -- superclasses as Givens + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver + -- Invariants: cc_pend_sc > 0 <=> + -- (a) cc_class has superclasses + -- (b) those superclasses are not yet explored } | CIrredCan { -- These stand for yet-unusable predicates @@ -273,8 +305,13 @@ data QCInst -- A much simplified version of ClsInst -- Always Given , qci_tvs :: [TcTyVar] -- The tvs , qci_pred :: TcPredType -- The ty - , qci_pend_sc :: Bool -- Same as cc_pend_sc flag in CDictCan - -- Invariant: True => qci_pred is a ClassPred + , qci_pend_sc :: ExpansionFuel + -- Invariants: qci_pend_sc > 0 => + -- (a) qci_pred is a ClassPred + -- (b) this class has superclass(es), and + -- (c) the superclass(es) are not explored yet + -- Same as cc_pend_sc flag in CDictCan + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver } instance Outputable QCInst where @@ -673,11 +710,11 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason - CQuantCan (QCI { qci_pend_sc = pend_sc }) - | pend_sc -> text "CQuantCan(psc)" + CQuantCan (QCI { qci_pend_sc = psc }) + | psc > 0 -> text "CQuantCan" <> parens (text "psc" <+> ppr psc) | otherwise -> text "CQuantCan" ----------------------------------- @@ -893,23 +930,24 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = f }) = pendingFuel f +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, --- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, +-- AND if so exhausts the fuel so that they are not expanded again +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = f }) + | pendingFuel f = Just (ct { cc_pend_sc = doNotExpand }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst -- Same as isPendingScDict, but for QCInsts -pendingScInst_maybe qci@(QCI { qci_pend_sc = True }) - = Just (qci { qci_pend_sc = False }) -pendingScInst_maybe _ = Nothing +pendingScInst_maybe qci@(QCI { qci_pend_sc = f }) + | pendingFuel f = Just (qci { qci_pend_sc = doNotExpand }) + | otherwise = Nothing superClassesMightHelp :: WantedConstraints -> Bool -- ^ True if taking superclasses of givens, or of wanteds (to perhaps @@ -928,11 +966,12 @@ superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics }) is_ip _ = False getPendingWantedScs :: Cts -> ([Ct], Cts) +-- in the return values [Ct] has original fuel while Cts has fuel exhausted getPendingWantedScs simples = mapAccumBagL get [] simples where - get acc ct | Just ct' <- pendingScDict_maybe ct - = (ct':acc, ct') + get acc ct | Just ct_exhausted <- pendingScDict_maybe ct + = (ct:acc, ct_exhausted) | otherwise = (acc, ct) ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -33,6 +33,9 @@ -fbang-patterns -fbuilding-cabal-package -fconstraint-solver-iterations +-fgivens-expansion-fuel +-fwanteds-expansion-fuel +-fqcs-expansion-fuel -fcontext-stack -fcross-module-specialize -fdiagnostics-color=always ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +class C [a] => C a where + foo :: a -> Int + +bar :: C a => a -> Int +bar x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -864,3 +864,5 @@ test('T22924', normal, compile, ['']) test('T22985a', normal, compile, ['-O']) test('T22985b', normal, compile, ['']) test('T23018', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a81e30f98a4fecab0afc2be5c582709a5f7942b1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a81e30f98a4fecab0afc2be5c582709a5f7942b1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 5 11:07:48 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 05 Mar 2023 06:07:48 -0500 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] 29 commits: Don't specialise incoherent instance applications Message-ID: <640478041e55f_3ab52b44aa059869496d@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - ce1254c1 by Sven Tennie at 2023-03-05T11:07:45+00:00 ghc-heap: Decode StgStack and its frames Previously, ghc-heap could only decode heap closures. The approach is explained in detail in note [Decoding the stack]. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Binds.hs-boot - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToJS/Prim.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/531ca427031471ed78952a8770dbcc8ae19a9ac7...ce1254c16b81f99aa4c4bf042a42cb8442c146ee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/531ca427031471ed78952a8770dbcc8ae19a9ac7...ce1254c16b81f99aa4c4bf042a42cb8442c146ee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 5 22:36:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 05 Mar 2023 17:36:51 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Add test for T22793 Message-ID: <640519831c49c_3ab52b4f3b74747319e6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 87aee8fb by Simon Peyton Jones at 2023-03-05T17:36:46-05:00 Add regression test for #22328 - - - - - 6 changed files: - docs/users_guide/9.6.1-notes.rst - + testsuite/tests/patsyn/should_compile/T22328.hs - testsuite/tests/patsyn/should_compile/all.T - + testsuite/tests/polykinds/T22793.hs - + testsuite/tests/polykinds/T22793.stderr - testsuite/tests/polykinds/all.T Changes: ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -197,7 +197,7 @@ Runtime system - GHC now provides a set of operations for introspecting on the threads of a program, ``GHC.Conc.listThreads``, as well as operations for querying a thread's - label (:base-ref:`GHC.Conc.threadLabel`) and status + label (:base-ref:`GHC.Conc.Sync.threadLabel`) and status (:base-ref:`GHC.Conc.threadStatus`). - Change default ``Ord`` implementation of ``(>=)``, ``(>)``, and ``(<)`` to use ===================================== testsuite/tests/patsyn/should_compile/T22328.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE TypeApplications, PatternSynonyms, GADTs, ViewPatterns #-} + +module T22328 where + +import Data.Typeable + +data Gadt x y where + ExistentialInGadt :: Typeable a => a -> Gadt x x + +pattern CastGadt :: Typeable a => x ~ y => a -> Gadt x y +pattern CastGadt a <- ExistentialInGadt (cast -> Just a) + +test :: Gadt i o -> Bool +test gadt = case gadt of + CastGadt @Bool a -> a + _ -> False ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -84,3 +84,4 @@ test('T14630', normal, compile, ['-Wname-shadowing']) test('T21531', [ grep_errmsg(r'INLINE') ], compile, ['-ddump-ds']) test('T22521', normal, compile, ['']) test('T23038', normal, compile_fail, ['']) +test('T22328', normal, compile, ['']) ===================================== testsuite/tests/polykinds/T22793.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module T22793 where + +import Data.Kind + +type Foo :: forall k. k -> k -> Constraint + +class Foo s a + +bob :: forall {k1} {ks} {ka} q (p :: k1 -> q -> Type) + (f :: ka -> q) (s :: ks) (t :: ks) + (a :: ka) (b :: ka). Foo s a + => p a (f b) -> p s (f t) +bob f = undefined ===================================== testsuite/tests/polykinds/T22793.stderr ===================================== @@ -0,0 +1,44 @@ + +T22793.hs:15:42: error: [GHC-25897] + • Couldn't match kind ‘ka’ with ‘k1’ + Expected kind ‘ks’, but ‘a’ has kind ‘ka’ + ‘ka’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:26-27 + ‘k1’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:16-17 + • In the second argument of ‘Foo’, namely ‘a’ + In the type signature: + bob :: forall {k1} + {ks} + {ka} + q + (p :: k1 -> q -> Type) + (f :: ka -> q) + (s :: ks) + (t :: ks) + (a :: ka) + (b :: ka). Foo s a => p a (f b) -> p s (f t) + +T22793.hs:16:11: error: [GHC-25897] + • Couldn't match kind ‘ks’ with ‘k1’ + Expected kind ‘k1’, but ‘a’ has kind ‘ka’ + ‘ks’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:21-22 + ‘k1’ is a rigid type variable bound by + the type signature for ‘bob’ + at T22793.hs:13:16-17 + • In the first argument of ‘p’, namely ‘a’ + In the type signature: + bob :: forall {k1} + {ks} + {ka} + q + (p :: k1 -> q -> Type) + (f :: ka -> q) + (s :: ks) + (t :: ks) + (a :: ka) + (b :: ka). Foo s a => p a (f b) -> p s (f t) ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -243,3 +243,4 @@ test('T22379a', normal, compile, ['']) test('T22379b', normal, compile, ['']) test('T22743', normal, compile_fail, ['']) test('T22742', normal, compile_fail, ['']) +test('T22793', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1121bb3a87c4d05725b0491441113641a90a3bc7...87aee8fb461a58510e38d7897a7d78e54ab6fa64 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1121bb3a87c4d05725b0491441113641a90a3bc7...87aee8fb461a58510e38d7897a7d78e54ab6fa64 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 5 23:16:22 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 05 Mar 2023 18:16:22 -0500 Subject: [Git][ghc/ghc][wip/T23070] Refactor the constraint solver pipeline Message-ID: <640522c62e1f4_3ab52b5018210875544e@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070 at Glasgow Haskell Compiler / GHC Commits: 5c3f9bd6 by Simon Peyton Jones at 2023-03-05T23:17:38+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - 2 changed files: - compiler/GHC/Tc/Solver/Canonical.hs - + compiler/GHC/Tc/Solver/Dict.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c3f9bd60b6e97f55880285ab1b7104138f61a1d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c3f9bd60b6e97f55880285ab1b7104138f61a1d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 00:57:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 05 Mar 2023 19:57:11 -0500 Subject: [Git][ghc/ghc][master] Fix typo in docs referring to threadLabel Message-ID: <64053a676d869_3ab52b51dea87c7616e6@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 1 changed file: - docs/users_guide/9.6.1-notes.rst Changes: ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -197,7 +197,7 @@ Runtime system - GHC now provides a set of operations for introspecting on the threads of a program, ``GHC.Conc.listThreads``, as well as operations for querying a thread's - label (:base-ref:`GHC.Conc.threadLabel`) and status + label (:base-ref:`GHC.Conc.Sync.threadLabel`) and status (:base-ref:`GHC.Conc.threadStatus`). - Change default ``Ord`` implementation of ``(>=)``, ``(>)``, and ``(<)`` to use View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6e1f3cdcd59e6834820be3c8dc89b66b27b5f57 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6e1f3cdcd59e6834820be3c8dc89b66b27b5f57 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 00:57:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 05 Mar 2023 19:57:45 -0500 Subject: [Git][ghc/ghc][master] Add regression test for #22328 Message-ID: <64053a8957804_3ab52b51ea60907647e3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 2 changed files: - + testsuite/tests/patsyn/should_compile/T22328.hs - testsuite/tests/patsyn/should_compile/all.T Changes: ===================================== testsuite/tests/patsyn/should_compile/T22328.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE TypeApplications, PatternSynonyms, GADTs, ViewPatterns #-} + +module T22328 where + +import Data.Typeable + +data Gadt x y where + ExistentialInGadt :: Typeable a => a -> Gadt x x + +pattern CastGadt :: Typeable a => x ~ y => a -> Gadt x y +pattern CastGadt a <- ExistentialInGadt (cast -> Just a) + +test :: Gadt i o -> Bool +test gadt = case gadt of + CastGadt @Bool a -> a + _ -> False ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -84,3 +84,4 @@ test('T14630', normal, compile, ['-Wname-shadowing']) test('T21531', [ grep_errmsg(r'INLINE') ], compile, ['-ddump-ds']) test('T22521', normal, compile, ['']) test('T23038', normal, compile_fail, ['']) +test('T22328', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/232cfc241c14ba6a49d9552a90a94857255e455d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/232cfc241c14ba6a49d9552a90a94857255e455d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 01:57:15 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Sun, 05 Mar 2023 20:57:15 -0500 Subject: [Git][ghc/ghc][wip/T21909] 3 commits: Fix typo in docs referring to threadLabel Message-ID: <6405487b3a18d_3ab52b53268b3c76854d@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 88aded02 by Apoorv Ingle at 2023-03-06T01:57:06+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [SimplifyInfer and UndecidableSuperClasses] - - - - - 14 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/expected-undocumented-flags.txt - + testsuite/tests/patsyn/should_compile/T22328.hs - testsuite/tests/patsyn/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Class.hs ===================================== @@ -17,8 +17,8 @@ module GHC.Core.Class ( mkClass, mkAbstractClass, classTyVars, classArity, classKey, className, classATs, classATItems, classTyCon, classMethods, classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta, - classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, classHasFds, - isAbstractClass, + classHasSCs, classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, + classHasFds, isAbstractClass, ) where import GHC.Prelude @@ -295,6 +295,9 @@ classSCTheta (Class { classBody = ConcreteClass { cls_sc_theta = theta_stuff }}) = theta_stuff classSCTheta _ = [] +classHasSCs :: Class -> Bool +classHasSCs cls = not (null (classSCTheta cls)) + classTvsFds :: Class -> ([TyVar], [FunDep TyVar]) classTvsFds c = (classTyVars c, classFunDeps c) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -517,7 +517,15 @@ data DynFlags = DynFlags { reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver -- Typically only 1 is needed - + givensFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < solverIterations + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + qcsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] homeUnitId_ :: UnitId, -- ^ Target home unit-id homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations @@ -1148,6 +1156,9 @@ defaultDynFlags mySettings = mainFunIs = Nothing, reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, homeUnitId_ = mainUnitId, homeUnitInstanceOf_ = Nothing, @@ -2733,6 +2744,12 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n })) , make_ord_flag defFlag "fconstraint-solver-iterations" (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n })) + , make_ord_flag defFlag "fgivens-expansion-fuel" + (intSuffix (\n d -> d { givensFuel = n })) + , make_ord_flag defFlag "fwanteds-expansion-fuel" + (intSuffix (\n d -> d { wantedsFuel = n })) + , make_ord_flag defFlag "fqcs-expansion-fuel" + (intSuffix (\n d -> d { qcsFuel = n })) , (Deprecated, defFlag "fcontext-stack" (intSuffixM (\n d -> do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead" ===================================== compiler/GHC/Settings/Constants.hs ===================================== @@ -30,6 +30,27 @@ mAX_REDUCTION_DEPTH = 200 mAX_SOLVER_ITERATIONS :: Int mAX_SOLVER_ITERATIONS = 4 +-- | In case of loopy quantified costraints constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_QC_FUEL :: Int +mAX_QC_FUEL = 3 + +-- | In case of loopy wanted constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_GIVENS_FUEL +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_WANTEDS_FUEL :: Int +mAX_WANTEDS_FUEL = 1 + +-- | In case of loopy given constraints, +-- how many times should we allow superclass expansions +-- Should be less than max_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_GIVENS_FUEL :: Int +mAX_GIVENS_FUEL = 3 + wORD64_SIZE :: Int wORD64_SIZE = 8 ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2338,6 +2338,10 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set + ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given + , text "new_given" <+> ppr new_given + , text "pending_wanted" <+> ppr pending_wanted + , text "new_wanted" <+> ppr new_wanted ]) ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } -- (not (null pending_given)): see Note [Superclass iteration] @@ -2366,6 +2370,72 @@ superclasses. In that case we check whether the new Wanteds actually led to any new unifications, and iterate the implications only if so. -} +{- Note [Expanding Recursive Superclasses and ExpansionFuel] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the class declaration (T21909) + + class C [a] => C a where + foo :: a -> Int + +and suppose during type inference we obtain an implication constraint: + + forall a. C a => C [[a]] + +To solve this implication constraint, we first expand one layer of the superclass +of Given constraints, but not for Wanted constraints. +(See Note [Eagerly expand given superclasses] and Note [Why adding superclasses can help] +in GHC.Tc.Solver.Canonical.) We thus get: + + [G] g1 :: C a + [G] g2 :: C [a] -- new superclass layer from g1 + [W] w1 :: C [[a]] + +Now, we cannot solve `w1` directly from `g1` or `g2` as we may not have +any instances for C. So we expand a layer of superclasses of each Wanteds and Givens +that we haven't expanded yet. +This is done in `maybe_simplify_again`. And we get: + + [G] g1 :: C a + [G] g2 :: C [a] + [G] g3 :: C [[a]] -- new superclass layer from g2, can solve w1 + [W] w1 :: C [[a]] + [W] w2 :: C [[[a]]] -- new superclass layer from w1, not solvable + +Now, although we can solve `w1` using `g3` (obtained from expanding `g2`), +we have a new wanted constraint `w2` (obtained from expanding `w1`) that cannot be solved. +We thus make another go at solving in `maybe_simplify_again` by expanding more +layers of superclasses. This looping is futile as Givens will never be able to catch up with Wanteds. + +Side Note: We don't need to solve `w2`, as it is a superclass of `w1` +and we only expand it to expose any functional dependencies (see Note [The superclass story]) +But it is a wanted constraint, so we expand it even though ultimately we discard its evidence. + +Solution: Simply bound the maximum number of layers of expansion for +Givens and Wanteds, with ExpansionFuel. Give the Givens more fuel +(say 3 layers) than the Wanteds (say 1 layer). Now the Givens will +win. The Wanteds don't need much fuel: we are only expanding at all +to expose functional dependencies, and wantedFuel=1 means we will +expand a full recursive layer. If the superclass hierarchy is +non-recursive (the normal case) one layer is therefore full expansion. + +The default value for wantedFuel = Constants.max_WANTEDS_FUEL = 1. +The default value for givenFuel = Constants.max_GIVENS_FUEL = 3. +Both are configurable via the `-fgivens-fuel` and `-fwanteds-fuel` +compiler flags. + +There are two preconditions for the default fuel values: + (1) default givenFuel >= default wantedsFuel + (2) default givenFuel < solverIterations + +Precondition (1) ensures that we expand givens atleast as many times as we expand wanted constraints +preferably givenFuel > wantedsFuel to avoid issues like T21909 while +the precondition (2) ensures that we do not reach the solver iteration limit and fail with a +more meaningful error message + +This also applies for quantified constraints; see `-fqcs-fuel` compiler flag and `QCI.qci_pend_sc` field. +-} + + solveNestedImplications :: Bag Implication -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -59,7 +59,7 @@ import Control.Monad import Data.Maybe ( isJust, isNothing ) import Data.List ( zip4 ) import GHC.Types.Basic - +import GHC.Driver.Session ( givensFuel, wantedsFuel, qcsFuel ) import qualified Data.Semigroup as S import Data.Bifunctor ( bimap ) @@ -154,9 +154,13 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys doNotExpand } + -- doNotExpand: We have already expanded superclasses for /this/ dict + -- so set the fuel to doNotExpand to avoid repeating expansion | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -168,7 +172,7 @@ canClassNC ev cls tys -- and Note [Solving CallStack constraints] in GHC.Tc.Solver.Types = do { -- First we emit a new constraint that will capture the -- given CallStack. - ; let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) + let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) -- We change the origin to IPOccOrigin so -- this rule does not fire again. -- See Note [Overview of implicit CallStacks] @@ -182,14 +186,20 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys doNotExpand + -- doNotExpand: No superclasses for class CallStack + -- See invariants in CDictCan.cc_pend_sc } | otherwise - = canClass ev cls tys (has_scs cls) + = do { dflags <- getDynFlags + ; let fuel | classHasSCs cls = wantedsFuel dflags + | otherwise = doNotExpand + -- See Invariants in `CCDictCan.cc_pend_sc` + ; canClass ev cls tys fuel + } where - has_scs cls = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -206,7 +216,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -307,10 +317,11 @@ So here's the plan: 4. Go round to (2) again. This loop (2,3,4) is implemented in GHC.Tc.Solver.simpl_loop. -The cc_pend_sc flag in a CDictCan records whether the superclasses of +The cc_pend_sc field in a CDictCan records whether the superclasses of this constraint have been expanded. Specifically, in Step 3 we only -expand superclasses for constraints with cc_pend_sc set to true (i.e. -isPendingScDict holds). +expand superclasses for constraints with cc_pend_sc > 0 +(i.e. isPendingScDict holds). +See Note [Expanding Recursive Superclasses and ExpansionFuel] Why do we do this? Two reasons: @@ -337,7 +348,8 @@ our strategy. Consider f :: C a => a -> Bool f x = x==x Then canClassNC gets the [G] d1: C a constraint, and eager emits superclasses -G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its sc_pend flag set.) +G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its cc_pend_sc has pending +expansion fuel.) When processing d3 we find a match with d1 in the inert set, and we always keep the inert item (d1) if possible: see Note [Replacement vs keeping] in GHC.Tc.Solver.Interact. So d3 dies a quick, happy death. @@ -484,7 +496,6 @@ the sc_theta_ids at all. So our final construction is makeSuperClasses :: [Ct] -> TcS [Ct] -- Returns strict superclasses, transitively, see Note [The superclass story] --- See Note [The superclass story] -- The loop-breaking here follows Note [Expanding superclasses] in GHC.Tc.Utils.TcType -- Specifically, for an incoming (C t) constraint, we return all of (C t)'s -- superclasses, up to /and including/ the first repetition of C @@ -493,39 +504,45 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- class C [a] => D a -- makeSuperClasses (C x) will return (D x, C [x]) -- --- NB: the incoming constraints have had their cc_pend_sc flag already --- flipped to False, by isPendingScDict, so we are /obliged/ to at --- least produce the immediate superclasses +-- NB: the incoming constraint's superclass will consume a unit of fuel +-- Preconditions on `cts`: 1. They are either `CDictCan` or `CQuantCan` +-- 2. Their fuel (stored in cc_pend_sc or qci_pend_sc) is > 0 makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys - go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev [] [] cls tys + go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +-- Precondition: fuel > 0 +-- Postcondition: fuel for recursive superclass ct is one unit less than cls fuel +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses (consumeFuel fuel) (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +-- The caller of this function is supposed to perform fuel book keeping +-- Precondition: fuel >= 0 +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -543,7 +560,8 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; assertFuelPrecondition fuel + $ mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -604,7 +622,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -619,7 +637,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -634,46 +652,53 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +-- Precondition: fuel >= 0 +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = assertFuelPrecondition fuel $ + mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +-- Precondition: fuel >= 0 +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) - ; return [this_ct] } -- cc_pend_sc of this_ct = True + ; assertFuelPrecondition fuel $ return [mk_this_ct fuel] } + -- cc_pend_sc of returning ct = fuel | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys - ; return (this_ct : sc_cts) } - -- cc_pend_sc of this_ct = False + ; sc_cts <- assertFuelPrecondition fuel $ + mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys + ; return (mk_this_ct doNotExpand : sc_cts) } + -- doNotExpand: we have expanded this cls's superclasses, so + -- exhaust the associated constraint's fuel, + -- to avoid duplicate work where cls_nm = className cls loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm - - this_ct | null tvs, null theta - = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } - -- NB: If there is a loop, we cut off, so we have not - -- added the superclasses, hence cc_pend_sc = True - | otherwise - = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys - , qci_ev = ev - , qci_pend_sc = loop_found }) + mk_this_ct :: ExpansionFuel -> Ct + mk_this_ct fuel | null tvs, null theta + = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys + , cc_pend_sc = fuel } + -- NB: If there is a loop, we cut off, so we have not + -- added the superclasses, hence cc_pend_sc = fuel + | otherwise + = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys + , qci_ev = ev + , qci_pend_sc = fuel }) {- Note [Equality superclasses in quantified constraints] @@ -828,19 +853,28 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev tvs theta cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canForAll ev False } + ; canForAll ev doNotExpand } + -- doNotExpand: as we have already (eagerly) expanded superclasses for this class | otherwise - = canForAll ev (isJust cls_pred_tys_maybe) - + = do { dflags <- getDynFlags + ; let fuel | Just (cls, _) <- cls_pred_tys_maybe + , classHasSCs cls = qcsFuel dflags + -- See invariants (a) and (b) in QCI.qci_pend_sc + -- qcsFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + -- See Note [Quantified constraints] + | otherwise = doNotExpand + ; canForAll ev fuel } where cls_pred_tys_maybe = getClassPredTys_maybe pred -canForAll :: CtEvidence -> Bool -> TcS (StopOrContinue Ct) +canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) -- We have a constraint (forall as. blah => C tys) -canForAll ev pend_sc +canForAll ev fuel = do { -- First rewrite it to apply the current substitution let pred = ctEvPred ev ; (redn, rewriters) <- rewrite ev pred @@ -850,14 +884,14 @@ canForAll ev pend_sc -- (It takes a lot less code to rewrite before decomposing.) ; case classifyPredType (ctEvPred new_ev) of ForAllPred tvs theta pred - -> solveForAll new_ev tvs theta pred pend_sc + -> solveForAll new_ev tvs theta pred fuel _ -> pprPanic "canForAll" (ppr new_ev) } } -solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> Bool +solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel -> TcS (StopOrContinue Ct) solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) - tvs theta pred _pend_sc + tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] setLclEnv (ctLocEnv loc) $ -- This setLclEnv is important: the emitImplicationTcS uses that @@ -903,12 +937,12 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo _ -> pSizeType pred -- See Note [Solving a Given forall-constraint] -solveForAll ev@(CtGiven {}) tvs _theta pred pend_sc +solveForAll ev@(CtGiven {}) tvs _theta pred fuel = do { addInertForAll qci ; stopWith ev "Given forall-constraint" } where qci = QCI { qci_ev = ev, qci_tvs = tvs - , qci_pred = pred, qci_pend_sc = pend_sc } + , qci_pred = pred, qci_pend_sc = fuel } {- Note [Solving a Wanted forall-constraint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -513,10 +513,13 @@ getInertGivens ; return (filter isGivenCt all_cts) } getPendingGivenScs :: TcS [Ct] --- Find all inert Given dictionaries, or quantified constraints, --- whose cc_pend_sc flag is True --- and that belong to the current level --- Set their cc_pend_sc flag to False in the inert set, and return that Ct +-- Find all inert Given dictionaries, or quantified constraints, such that +-- 1. cc_pend_sc flag has fuel strictly > 0 +-- 2. belongs to the current level +-- For each such dictionary: +-- * Return it (with unmodified cc_pend_sc) in sc_pending +-- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand +-- to record that we have expanded superclasses for this dict getPendingGivenScs = do { lvl <- getTcLevel ; updRetInertCans (get_sc_pending lvl) } @@ -530,29 +533,33 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) sc_pending = sc_pend_insts ++ sc_pend_dicts sc_pend_dicts = foldDicts get_pending dicts [] - dicts' = foldr add dicts sc_pend_dicts + dicts' = foldr exhaustAndAdd dicts sc_pend_dicts (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts - | Just dict' <- pendingScDict_maybe dict + | isPendingScDict dict , belongs_to_this_level (ctEvidence dict) - = dict' : dicts + = dict : dicts | otherwise = dicts - add :: Ct -> DictMap Ct -> DictMap Ct - add ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts - = addDict dicts cls tys ct - add ct _ = pprPanic "getPendingScDicts" (ppr ct) + exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct + exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts + -- exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) + exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) get_pending_inst cts qci@(QCI { qci_ev = ev }) | Just qci' <- pendingScInst_maybe qci , belongs_to_this_level ev - = (CQuantCan qci' : cts, qci') + = (CQuantCan qci : cts, qci') + -- qci' have their fuel exhausted + -- we don't want to expand these constraints again + -- qci is expanded | otherwise = (cts, qci) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,6 +11,8 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, + ExpansionFuel, doNotExpand, consumeFuel, pendingFuel, + assertFuelPrecondition, assertFuelPreconditionStrict, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -138,8 +140,6 @@ import Data.Word ( Word8 ) import Data.List ( intersperse ) - - {- ************************************************************************ * * @@ -191,6 +191,37 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- Invariant: ExpansionFuel should always be >= 0 +-- see Note [Expanding Recursive Superclasses and ExpansionFuel] +type ExpansionFuel = Int + +-- | Do not expand superclasses any further +doNotExpand :: ExpansionFuel +doNotExpand = 0 + +-- | Consumes one unit of fuel. +-- Precondition: fuel > 0 +consumeFuel :: ExpansionFuel -> ExpansionFuel +consumeFuel fuel = assertFuelPreconditionStrict fuel $ fuel - 1 + +-- | Returns True if we have any fuel left for superclass expansion +pendingFuel :: ExpansionFuel -> Bool +pendingFuel n = n > 0 + +insufficientFuelError :: SDoc +insufficientFuelError = text "Superclass expansion fuel should be > 0" + +-- | asserts if fuel is non-negative +assertFuelPrecondition :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPrecondition #-} +assertFuelPrecondition fuel = assertPpr (fuel >= 0) insufficientFuelError + +-- | asserts if fuel is strictly greater than 0 +assertFuelPreconditionStrict :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPreconditionStrict #-} +assertFuelPreconditionStrict fuel = assertPpr (pendingFuel fuel) insufficientFuelError + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,11 +230,12 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those - -- superclasses as Givens + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver + -- Invariants: cc_pend_sc > 0 <=> + -- (a) cc_class has superclasses + -- (b) those superclasses are not yet explored } | CIrredCan { -- These stand for yet-unusable predicates @@ -273,8 +305,13 @@ data QCInst -- A much simplified version of ClsInst -- Always Given , qci_tvs :: [TcTyVar] -- The tvs , qci_pred :: TcPredType -- The ty - , qci_pend_sc :: Bool -- Same as cc_pend_sc flag in CDictCan - -- Invariant: True => qci_pred is a ClassPred + , qci_pend_sc :: ExpansionFuel + -- Invariants: qci_pend_sc > 0 => + -- (a) qci_pred is a ClassPred + -- (b) this class has superclass(es), and + -- (c) the superclass(es) are not explored yet + -- Same as cc_pend_sc flag in CDictCan + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver } instance Outputable QCInst where @@ -673,11 +710,11 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason - CQuantCan (QCI { qci_pend_sc = pend_sc }) - | pend_sc -> text "CQuantCan(psc)" + CQuantCan (QCI { qci_pend_sc = psc }) + | psc > 0 -> text "CQuantCan" <> parens (text "psc" <+> ppr psc) | otherwise -> text "CQuantCan" ----------------------------------- @@ -893,23 +930,24 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = f }) = pendingFuel f +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, --- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, +-- AND if so exhausts the fuel so that they are not expanded again +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = f }) + | pendingFuel f = Just (ct { cc_pend_sc = doNotExpand }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst -- Same as isPendingScDict, but for QCInsts -pendingScInst_maybe qci@(QCI { qci_pend_sc = True }) - = Just (qci { qci_pend_sc = False }) -pendingScInst_maybe _ = Nothing +pendingScInst_maybe qci@(QCI { qci_pend_sc = f }) + | pendingFuel f = Just (qci { qci_pend_sc = doNotExpand }) + | otherwise = Nothing superClassesMightHelp :: WantedConstraints -> Bool -- ^ True if taking superclasses of givens, or of wanteds (to perhaps @@ -928,11 +966,12 @@ superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics }) is_ip _ = False getPendingWantedScs :: Cts -> ([Ct], Cts) +-- in the return values [Ct] has original fuel while Cts has fuel exhausted getPendingWantedScs simples = mapAccumBagL get [] simples where - get acc ct | Just ct' <- pendingScDict_maybe ct - = (ct':acc, ct') + get acc ct | Just ct_exhausted <- pendingScDict_maybe ct + = (ct:acc, ct_exhausted) | otherwise = (acc, ct) ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -197,7 +197,7 @@ Runtime system - GHC now provides a set of operations for introspecting on the threads of a program, ``GHC.Conc.listThreads``, as well as operations for querying a thread's - label (:base-ref:`GHC.Conc.threadLabel`) and status + label (:base-ref:`GHC.Conc.Sync.threadLabel`) and status (:base-ref:`GHC.Conc.threadStatus`). - Change default ``Ord`` implementation of ``(>=)``, ``(>)``, and ``(<)`` to use ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -33,6 +33,9 @@ -fbang-patterns -fbuilding-cabal-package -fconstraint-solver-iterations +-fgivens-expansion-fuel +-fwanteds-expansion-fuel +-fqcs-expansion-fuel -fcontext-stack -fcross-module-specialize -fdiagnostics-color=always ===================================== testsuite/tests/patsyn/should_compile/T22328.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE TypeApplications, PatternSynonyms, GADTs, ViewPatterns #-} + +module T22328 where + +import Data.Typeable + +data Gadt x y where + ExistentialInGadt :: Typeable a => a -> Gadt x x + +pattern CastGadt :: Typeable a => x ~ y => a -> Gadt x y +pattern CastGadt a <- ExistentialInGadt (cast -> Just a) + +test :: Gadt i o -> Bool +test gadt = case gadt of + CastGadt @Bool a -> a + _ -> False ===================================== testsuite/tests/patsyn/should_compile/all.T ===================================== @@ -84,3 +84,4 @@ test('T14630', normal, compile, ['-Wname-shadowing']) test('T21531', [ grep_errmsg(r'INLINE') ], compile, ['-ddump-ds']) test('T22521', normal, compile, ['']) test('T23038', normal, compile_fail, ['']) +test('T22328', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +class C [a] => C a where + foo :: a -> Int + +bar :: C a => a -> Int +bar x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -864,3 +864,5 @@ test('T22924', normal, compile, ['']) test('T22985a', normal, compile, ['-O']) test('T22985b', normal, compile, ['']) test('T23018', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a81e30f98a4fecab0afc2be5c582709a5f7942b1...88aded02b2d926ba3d3701c4d37bfa99707d052d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a81e30f98a4fecab0afc2be5c582709a5f7942b1...88aded02b2d926ba3d3701c4d37bfa99707d052d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 09:18:20 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 06 Mar 2023 04:18:20 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/js-exports Message-ID: <6405afdc80c3e_3ab52b5a44b5c480239@gitlab.mail> Josh Meredith pushed new branch wip/js-exports at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-exports You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 13:18:42 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 06 Mar 2023 08:18:42 -0500 Subject: [Git][ghc/ghc][wip/T21909] Constraint simplification loop now depends on `ExpansionFuel` Message-ID: <6405e8321a8b5_3ab52b5e59019c8921ec@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: 5b5426d0 by Apoorv Ingle at 2023-03-06T07:18:26-06:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [SimplifyInfer and UndecidableSuperClasses] - - - - - 11 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - docs/users_guide/expected-undocumented-flags.txt - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Class.hs ===================================== @@ -17,8 +17,8 @@ module GHC.Core.Class ( mkClass, mkAbstractClass, classTyVars, classArity, classKey, className, classATs, classATItems, classTyCon, classMethods, classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta, - classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, classHasFds, - isAbstractClass, + classHasSCs, classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, + classHasFds, isAbstractClass, ) where import GHC.Prelude @@ -295,6 +295,9 @@ classSCTheta (Class { classBody = ConcreteClass { cls_sc_theta = theta_stuff }}) = theta_stuff classSCTheta _ = [] +classHasSCs :: Class -> Bool +classHasSCs cls = not (null (classSCTheta cls)) + classTvsFds :: Class -> ([TyVar], [FunDep TyVar]) classTvsFds c = (classTyVars c, classFunDeps c) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -517,7 +517,15 @@ data DynFlags = DynFlags { reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver -- Typically only 1 is needed - + givensFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < solverIterations + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + qcsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] homeUnitId_ :: UnitId, -- ^ Target home unit-id homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations @@ -1148,6 +1156,9 @@ defaultDynFlags mySettings = mainFunIs = Nothing, reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, homeUnitId_ = mainUnitId, homeUnitInstanceOf_ = Nothing, @@ -2733,6 +2744,12 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n })) , make_ord_flag defFlag "fconstraint-solver-iterations" (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n })) + , make_ord_flag defFlag "fgivens-expansion-fuel" + (intSuffix (\n d -> d { givensFuel = n })) + , make_ord_flag defFlag "fwanteds-expansion-fuel" + (intSuffix (\n d -> d { wantedsFuel = n })) + , make_ord_flag defFlag "fqcs-expansion-fuel" + (intSuffix (\n d -> d { qcsFuel = n })) , (Deprecated, defFlag "fcontext-stack" (intSuffixM (\n d -> do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead" ===================================== compiler/GHC/Settings/Constants.hs ===================================== @@ -30,6 +30,27 @@ mAX_REDUCTION_DEPTH = 200 mAX_SOLVER_ITERATIONS :: Int mAX_SOLVER_ITERATIONS = 4 +-- | In case of loopy quantified costraints constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_QC_FUEL :: Int +mAX_QC_FUEL = 3 + +-- | In case of loopy wanted constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_GIVENS_FUEL +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_WANTEDS_FUEL :: Int +mAX_WANTEDS_FUEL = 1 + +-- | In case of loopy given constraints, +-- how many times should we allow superclass expansions +-- Should be less than max_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_GIVENS_FUEL :: Int +mAX_GIVENS_FUEL = 3 + wORD64_SIZE :: Int wORD64_SIZE = 8 ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2338,6 +2338,10 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set + ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given + , text "new_given" <+> ppr new_given + , text "pending_wanted" <+> ppr pending_wanted + , text "new_wanted" <+> ppr new_wanted ]) ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } -- (not (null pending_given)): see Note [Superclass iteration] @@ -2366,6 +2370,72 @@ superclasses. In that case we check whether the new Wanteds actually led to any new unifications, and iterate the implications only if so. -} +{- Note [Expanding Recursive Superclasses and ExpansionFuel] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the class declaration (T21909) + + class C [a] => C a where + foo :: a -> Int + +and suppose during type inference we obtain an implication constraint: + + forall a. C a => C [[a]] + +To solve this implication constraint, we first expand one layer of the superclass +of Given constraints, but not for Wanted constraints. +(See Note [Eagerly expand given superclasses] and Note [Why adding superclasses can help] +in GHC.Tc.Solver.Canonical.) We thus get: + + [G] g1 :: C a + [G] g2 :: C [a] -- new superclass layer from g1 + [W] w1 :: C [[a]] + +Now, we cannot solve `w1` directly from `g1` or `g2` as we may not have +any instances for C. So we expand a layer of superclasses of each Wanteds and Givens +that we haven't expanded yet. +This is done in `maybe_simplify_again`. And we get: + + [G] g1 :: C a + [G] g2 :: C [a] + [G] g3 :: C [[a]] -- new superclass layer from g2, can solve w1 + [W] w1 :: C [[a]] + [W] w2 :: C [[[a]]] -- new superclass layer from w1, not solvable + +Now, although we can solve `w1` using `g3` (obtained from expanding `g2`), +we have a new wanted constraint `w2` (obtained from expanding `w1`) that cannot be solved. +We thus make another go at solving in `maybe_simplify_again` by expanding more +layers of superclasses. This looping is futile as Givens will never be able to catch up with Wanteds. + +Side Note: We don't need to solve `w2`, as it is a superclass of `w1` +and we only expand it to expose any functional dependencies (see Note [The superclass story]) +But it is a wanted constraint, so we expand it even though ultimately we discard its evidence. + +Solution: Simply bound the maximum number of layers of expansion for +Givens and Wanteds, with ExpansionFuel. Give the Givens more fuel +(say 3 layers) than the Wanteds (say 1 layer). Now the Givens will +win. The Wanteds don't need much fuel: we are only expanding at all +to expose functional dependencies, and wantedFuel=1 means we will +expand a full recursive layer. If the superclass hierarchy is +non-recursive (the normal case) one layer is therefore full expansion. + +The default value for wantedFuel = Constants.max_WANTEDS_FUEL = 1. +The default value for givenFuel = Constants.max_GIVENS_FUEL = 3. +Both are configurable via the `-fgivens-fuel` and `-fwanteds-fuel` +compiler flags. + +There are two preconditions for the default fuel values: + (1) default givenFuel >= default wantedsFuel + (2) default givenFuel < solverIterations + +Precondition (1) ensures that we expand givens atleast as many times as we expand wanted constraints +preferably givenFuel > wantedsFuel to avoid issues like T21909 while +the precondition (2) ensures that we do not reach the solver iteration limit and fail with a +more meaningful error message + +This also applies for quantified constraints; see `-fqcs-fuel` compiler flag and `QCI.qci_pend_sc` field. +-} + + solveNestedImplications :: Bag Implication -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -59,7 +59,7 @@ import Control.Monad import Data.Maybe ( isJust, isNothing ) import Data.List ( zip4 ) import GHC.Types.Basic - +import GHC.Driver.Session ( givensFuel, wantedsFuel, qcsFuel ) import qualified Data.Semigroup as S import Data.Bifunctor ( bimap ) @@ -154,9 +154,13 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys doNotExpand } + -- doNotExpand: We have already expanded superclasses for /this/ dict + -- so set the fuel to doNotExpand to avoid repeating expansion | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -168,7 +172,7 @@ canClassNC ev cls tys -- and Note [Solving CallStack constraints] in GHC.Tc.Solver.Types = do { -- First we emit a new constraint that will capture the -- given CallStack. - ; let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) + let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) -- We change the origin to IPOccOrigin so -- this rule does not fire again. -- See Note [Overview of implicit CallStacks] @@ -182,14 +186,20 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys doNotExpand + -- doNotExpand: No superclasses for class CallStack + -- See invariants in CDictCan.cc_pend_sc } | otherwise - = canClass ev cls tys (has_scs cls) + = do { dflags <- getDynFlags + ; let fuel | classHasSCs cls = wantedsFuel dflags + | otherwise = doNotExpand + -- See Invariants in `CCDictCan.cc_pend_sc` + ; canClass ev cls tys fuel + } where - has_scs cls = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -206,7 +216,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -307,10 +317,11 @@ So here's the plan: 4. Go round to (2) again. This loop (2,3,4) is implemented in GHC.Tc.Solver.simpl_loop. -The cc_pend_sc flag in a CDictCan records whether the superclasses of +The cc_pend_sc field in a CDictCan records whether the superclasses of this constraint have been expanded. Specifically, in Step 3 we only -expand superclasses for constraints with cc_pend_sc set to true (i.e. -isPendingScDict holds). +expand superclasses for constraints with cc_pend_sc > 0 +(i.e. isPendingScDict holds). +See Note [Expanding Recursive Superclasses and ExpansionFuel] Why do we do this? Two reasons: @@ -337,7 +348,8 @@ our strategy. Consider f :: C a => a -> Bool f x = x==x Then canClassNC gets the [G] d1: C a constraint, and eager emits superclasses -G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its sc_pend flag set.) +G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its cc_pend_sc has pending +expansion fuel.) When processing d3 we find a match with d1 in the inert set, and we always keep the inert item (d1) if possible: see Note [Replacement vs keeping] in GHC.Tc.Solver.Interact. So d3 dies a quick, happy death. @@ -484,7 +496,6 @@ the sc_theta_ids at all. So our final construction is makeSuperClasses :: [Ct] -> TcS [Ct] -- Returns strict superclasses, transitively, see Note [The superclass story] --- See Note [The superclass story] -- The loop-breaking here follows Note [Expanding superclasses] in GHC.Tc.Utils.TcType -- Specifically, for an incoming (C t) constraint, we return all of (C t)'s -- superclasses, up to /and including/ the first repetition of C @@ -493,39 +504,45 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- class C [a] => D a -- makeSuperClasses (C x) will return (D x, C [x]) -- --- NB: the incoming constraints have had their cc_pend_sc flag already --- flipped to False, by isPendingScDict, so we are /obliged/ to at --- least produce the immediate superclasses +-- NB: the incoming constraint's superclass will consume a unit of fuel +-- Preconditions on `cts`: 1. They are either `CDictCan` or `CQuantCan` +-- 2. Their fuel (stored in cc_pend_sc or qci_pend_sc) is > 0 makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys - go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev [] [] cls tys + go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +-- Precondition: fuel > 0 +-- Postcondition: fuel for recursive superclass ct is one unit less than cls fuel +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses (consumeFuel fuel) (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +-- The caller of this function is supposed to perform fuel book keeping +-- Precondition: fuel >= 0 +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -543,7 +560,8 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; assertFuelPrecondition fuel + $ mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -604,7 +622,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -619,7 +637,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -634,46 +652,53 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +-- Precondition: fuel >= 0 +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = assertFuelPrecondition fuel $ + mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +-- Precondition: fuel >= 0 +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) - ; return [this_ct] } -- cc_pend_sc of this_ct = True + ; assertFuelPrecondition fuel $ return [mk_this_ct fuel] } + -- cc_pend_sc of returning ct = fuel | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys - ; return (this_ct : sc_cts) } - -- cc_pend_sc of this_ct = False + ; sc_cts <- assertFuelPrecondition fuel $ + mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys + ; return (mk_this_ct doNotExpand : sc_cts) } + -- doNotExpand: we have expanded this cls's superclasses, so + -- exhaust the associated constraint's fuel, + -- to avoid duplicate work where cls_nm = className cls loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm - - this_ct | null tvs, null theta - = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } - -- NB: If there is a loop, we cut off, so we have not - -- added the superclasses, hence cc_pend_sc = True - | otherwise - = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys - , qci_ev = ev - , qci_pend_sc = loop_found }) + mk_this_ct :: ExpansionFuel -> Ct + mk_this_ct fuel | null tvs, null theta + = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys + , cc_pend_sc = fuel } + -- NB: If there is a loop, we cut off, so we have not + -- added the superclasses, hence cc_pend_sc = fuel + | otherwise + = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys + , qci_ev = ev + , qci_pend_sc = fuel }) {- Note [Equality superclasses in quantified constraints] @@ -828,19 +853,28 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev tvs theta cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canForAll ev False } + ; canForAll ev doNotExpand } + -- doNotExpand: as we have already (eagerly) expanded superclasses for this class | otherwise - = canForAll ev (isJust cls_pred_tys_maybe) - + = do { dflags <- getDynFlags + ; let fuel | Just (cls, _) <- cls_pred_tys_maybe + , classHasSCs cls = qcsFuel dflags + -- See invariants (a) and (b) in QCI.qci_pend_sc + -- qcsFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + -- See Note [Quantified constraints] + | otherwise = doNotExpand + ; canForAll ev fuel } where cls_pred_tys_maybe = getClassPredTys_maybe pred -canForAll :: CtEvidence -> Bool -> TcS (StopOrContinue Ct) +canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) -- We have a constraint (forall as. blah => C tys) -canForAll ev pend_sc +canForAll ev fuel = do { -- First rewrite it to apply the current substitution let pred = ctEvPred ev ; (redn, rewriters) <- rewrite ev pred @@ -850,14 +884,14 @@ canForAll ev pend_sc -- (It takes a lot less code to rewrite before decomposing.) ; case classifyPredType (ctEvPred new_ev) of ForAllPred tvs theta pred - -> solveForAll new_ev tvs theta pred pend_sc + -> solveForAll new_ev tvs theta pred fuel _ -> pprPanic "canForAll" (ppr new_ev) } } -solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> Bool +solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel -> TcS (StopOrContinue Ct) solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) - tvs theta pred _pend_sc + tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] setLclEnv (ctLocEnv loc) $ -- This setLclEnv is important: the emitImplicationTcS uses that @@ -903,12 +937,12 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo _ -> pSizeType pred -- See Note [Solving a Given forall-constraint] -solveForAll ev@(CtGiven {}) tvs _theta pred pend_sc +solveForAll ev@(CtGiven {}) tvs _theta pred fuel = do { addInertForAll qci ; stopWith ev "Given forall-constraint" } where qci = QCI { qci_ev = ev, qci_tvs = tvs - , qci_pred = pred, qci_pend_sc = pend_sc } + , qci_pred = pred, qci_pend_sc = fuel } {- Note [Solving a Wanted forall-constraint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -513,10 +513,13 @@ getInertGivens ; return (filter isGivenCt all_cts) } getPendingGivenScs :: TcS [Ct] --- Find all inert Given dictionaries, or quantified constraints, --- whose cc_pend_sc flag is True --- and that belong to the current level --- Set their cc_pend_sc flag to False in the inert set, and return that Ct +-- Find all inert Given dictionaries, or quantified constraints, such that +-- 1. cc_pend_sc flag has fuel strictly > 0 +-- 2. belongs to the current level +-- For each such dictionary: +-- * Return it (with unmodified cc_pend_sc) in sc_pending +-- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand +-- to record that we have expanded superclasses for this dict getPendingGivenScs = do { lvl <- getTcLevel ; updRetInertCans (get_sc_pending lvl) } @@ -530,29 +533,33 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) sc_pending = sc_pend_insts ++ sc_pend_dicts sc_pend_dicts = foldDicts get_pending dicts [] - dicts' = foldr add dicts sc_pend_dicts + dicts' = foldr exhaustAndAdd dicts sc_pend_dicts (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts - | Just dict' <- pendingScDict_maybe dict + | isPendingScDict dict , belongs_to_this_level (ctEvidence dict) - = dict' : dicts + = dict : dicts | otherwise = dicts - add :: Ct -> DictMap Ct -> DictMap Ct - add ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts - = addDict dicts cls tys ct - add ct _ = pprPanic "getPendingScDicts" (ppr ct) + exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct + exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts + -- exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) + exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) get_pending_inst cts qci@(QCI { qci_ev = ev }) | Just qci' <- pendingScInst_maybe qci , belongs_to_this_level ev - = (CQuantCan qci' : cts, qci') + = (CQuantCan qci : cts, qci') + -- qci' have their fuel exhausted + -- we don't want to expand these constraints again + -- qci is expanded | otherwise = (cts, qci) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,6 +11,8 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, + ExpansionFuel, doNotExpand, consumeFuel, pendingFuel, + assertFuelPrecondition, assertFuelPreconditionStrict, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -138,8 +140,6 @@ import Data.Word ( Word8 ) import Data.List ( intersperse ) - - {- ************************************************************************ * * @@ -191,6 +191,37 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- Invariant: ExpansionFuel should always be >= 0 +-- see Note [Expanding Recursive Superclasses and ExpansionFuel] +type ExpansionFuel = Int + +-- | Do not expand superclasses any further +doNotExpand :: ExpansionFuel +doNotExpand = 0 + +-- | Consumes one unit of fuel. +-- Precondition: fuel > 0 +consumeFuel :: ExpansionFuel -> ExpansionFuel +consumeFuel fuel = assertFuelPreconditionStrict fuel $ fuel - 1 + +-- | Returns True if we have any fuel left for superclass expansion +pendingFuel :: ExpansionFuel -> Bool +pendingFuel n = n > 0 + +insufficientFuelError :: SDoc +insufficientFuelError = text "Superclass expansion fuel should be > 0" + +-- | asserts if fuel is non-negative +assertFuelPrecondition :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPrecondition #-} +assertFuelPrecondition fuel = assertPpr (fuel >= 0) insufficientFuelError + +-- | asserts if fuel is strictly greater than 0 +assertFuelPreconditionStrict :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPreconditionStrict #-} +assertFuelPreconditionStrict fuel = assertPpr (pendingFuel fuel) insufficientFuelError + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,11 +230,12 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those - -- superclasses as Givens + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver + -- Invariants: cc_pend_sc > 0 <=> + -- (a) cc_class has superclasses + -- (b) those superclasses are not yet explored } | CIrredCan { -- These stand for yet-unusable predicates @@ -273,8 +305,13 @@ data QCInst -- A much simplified version of ClsInst -- Always Given , qci_tvs :: [TcTyVar] -- The tvs , qci_pred :: TcPredType -- The ty - , qci_pend_sc :: Bool -- Same as cc_pend_sc flag in CDictCan - -- Invariant: True => qci_pred is a ClassPred + , qci_pend_sc :: ExpansionFuel + -- Invariants: qci_pend_sc > 0 => + -- (a) qci_pred is a ClassPred + -- (b) this class has superclass(es), and + -- (c) the superclass(es) are not explored yet + -- Same as cc_pend_sc flag in CDictCan + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver } instance Outputable QCInst where @@ -673,11 +710,11 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason - CQuantCan (QCI { qci_pend_sc = pend_sc }) - | pend_sc -> text "CQuantCan(psc)" + CQuantCan (QCI { qci_pend_sc = psc }) + | psc > 0 -> text "CQuantCan" <> parens (text "psc" <+> ppr psc) | otherwise -> text "CQuantCan" ----------------------------------- @@ -893,23 +930,24 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = f }) = pendingFuel f +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, --- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, +-- AND if so exhausts the fuel so that they are not expanded again +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = f }) + | pendingFuel f = Just (ct { cc_pend_sc = doNotExpand }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst -- Same as isPendingScDict, but for QCInsts -pendingScInst_maybe qci@(QCI { qci_pend_sc = True }) - = Just (qci { qci_pend_sc = False }) -pendingScInst_maybe _ = Nothing +pendingScInst_maybe qci@(QCI { qci_pend_sc = f }) + | pendingFuel f = Just (qci { qci_pend_sc = doNotExpand }) + | otherwise = Nothing superClassesMightHelp :: WantedConstraints -> Bool -- ^ True if taking superclasses of givens, or of wanteds (to perhaps @@ -928,11 +966,12 @@ superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics }) is_ip _ = False getPendingWantedScs :: Cts -> ([Ct], Cts) +-- in the return values [Ct] has original fuel while Cts has fuel exhausted getPendingWantedScs simples = mapAccumBagL get [] simples where - get acc ct | Just ct' <- pendingScDict_maybe ct - = (ct':acc, ct') + get acc ct | Just ct_exhausted <- pendingScDict_maybe ct + = (ct:acc, ct_exhausted) | otherwise = (acc, ct) ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -33,6 +33,9 @@ -fbang-patterns -fbuilding-cabal-package -fconstraint-solver-iterations +-fgivens-expansion-fuel +-fwanteds-expansion-fuel +-fqcs-expansion-fuel -fcontext-stack -fcross-module-specialize -fdiagnostics-color=always ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +class C [a] => C a where + foo :: a -> Int + +bar :: C a => a -> Int +bar x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -864,3 +864,5 @@ test('T22924', normal, compile, ['']) test('T22985a', normal, compile, ['-O']) test('T22985b', normal, compile, ['']) test('T23018', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b5426d08c79be79685ea84281ed67c273ee2a60 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b5426d08c79be79685ea84281ed67c273ee2a60 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 13:30:36 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 06 Mar 2023 08:30:36 -0500 Subject: [Git][ghc/ghc][wip/T21909] Constraint simplification loop now depends on `ExpansionFuel` Message-ID: <6405eafca4ffe_3ab52b5e815ae8903897@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: 7e5f4727 by Apoorv Ingle at 2023-03-06T07:29:47-06:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - 11 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - docs/users_guide/expected-undocumented-flags.txt - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Class.hs ===================================== @@ -17,8 +17,8 @@ module GHC.Core.Class ( mkClass, mkAbstractClass, classTyVars, classArity, classKey, className, classATs, classATItems, classTyCon, classMethods, classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta, - classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, classHasFds, - isAbstractClass, + classHasSCs, classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, + classHasFds, isAbstractClass, ) where import GHC.Prelude @@ -295,6 +295,9 @@ classSCTheta (Class { classBody = ConcreteClass { cls_sc_theta = theta_stuff }}) = theta_stuff classSCTheta _ = [] +classHasSCs :: Class -> Bool +classHasSCs cls = not (null (classSCTheta cls)) + classTvsFds :: Class -> ([TyVar], [FunDep TyVar]) classTvsFds c = (classTyVars c, classFunDeps c) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -517,7 +517,15 @@ data DynFlags = DynFlags { reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver -- Typically only 1 is needed - + givensFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < solverIterations + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + qcsFuel :: Int, -- ^ Number of layers of superclass expansion + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] homeUnitId_ :: UnitId, -- ^ Target home unit-id homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations @@ -1148,6 +1156,9 @@ defaultDynFlags mySettings = mainFunIs = Nothing, reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, homeUnitId_ = mainUnitId, homeUnitInstanceOf_ = Nothing, @@ -2733,6 +2744,12 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n })) , make_ord_flag defFlag "fconstraint-solver-iterations" (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n })) + , make_ord_flag defFlag "fgivens-expansion-fuel" + (intSuffix (\n d -> d { givensFuel = n })) + , make_ord_flag defFlag "fwanteds-expansion-fuel" + (intSuffix (\n d -> d { wantedsFuel = n })) + , make_ord_flag defFlag "fqcs-expansion-fuel" + (intSuffix (\n d -> d { qcsFuel = n })) , (Deprecated, defFlag "fcontext-stack" (intSuffixM (\n d -> do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead" ===================================== compiler/GHC/Settings/Constants.hs ===================================== @@ -30,6 +30,27 @@ mAX_REDUCTION_DEPTH = 200 mAX_SOLVER_ITERATIONS :: Int mAX_SOLVER_ITERATIONS = 4 +-- | In case of loopy quantified costraints constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_QC_FUEL :: Int +mAX_QC_FUEL = 3 + +-- | In case of loopy wanted constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_GIVENS_FUEL +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_WANTEDS_FUEL :: Int +mAX_WANTEDS_FUEL = 1 + +-- | In case of loopy given constraints, +-- how many times should we allow superclass expansions +-- Should be less than max_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_GIVENS_FUEL :: Int +mAX_GIVENS_FUEL = 3 + wORD64_SIZE :: Int wORD64_SIZE = 8 ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2338,6 +2338,10 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set + ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given + , text "new_given" <+> ppr new_given + , text "pending_wanted" <+> ppr pending_wanted + , text "new_wanted" <+> ppr new_wanted ]) ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } -- (not (null pending_given)): see Note [Superclass iteration] @@ -2366,6 +2370,72 @@ superclasses. In that case we check whether the new Wanteds actually led to any new unifications, and iterate the implications only if so. -} +{- Note [Expanding Recursive Superclasses and ExpansionFuel] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the class declaration (T21909) + + class C [a] => C a where + foo :: a -> Int + +and suppose during type inference we obtain an implication constraint: + + forall a. C a => C [[a]] + +To solve this implication constraint, we first expand one layer of the superclass +of Given constraints, but not for Wanted constraints. +(See Note [Eagerly expand given superclasses] and Note [Why adding superclasses can help] +in GHC.Tc.Solver.Canonical.) We thus get: + + [G] g1 :: C a + [G] g2 :: C [a] -- new superclass layer from g1 + [W] w1 :: C [[a]] + +Now, we cannot solve `w1` directly from `g1` or `g2` as we may not have +any instances for C. So we expand a layer of superclasses of each Wanteds and Givens +that we haven't expanded yet. +This is done in `maybe_simplify_again`. And we get: + + [G] g1 :: C a + [G] g2 :: C [a] + [G] g3 :: C [[a]] -- new superclass layer from g2, can solve w1 + [W] w1 :: C [[a]] + [W] w2 :: C [[[a]]] -- new superclass layer from w1, not solvable + +Now, although we can solve `w1` using `g3` (obtained from expanding `g2`), +we have a new wanted constraint `w2` (obtained from expanding `w1`) that cannot be solved. +We thus make another go at solving in `maybe_simplify_again` by expanding more +layers of superclasses. This looping is futile as Givens will never be able to catch up with Wanteds. + +Side Note: We don't need to solve `w2`, as it is a superclass of `w1` +and we only expand it to expose any functional dependencies (see Note [The superclass story]) +But it is a wanted constraint, so we expand it even though ultimately we discard its evidence. + +Solution: Simply bound the maximum number of layers of expansion for +Givens and Wanteds, with ExpansionFuel. Give the Givens more fuel +(say 3 layers) than the Wanteds (say 1 layer). Now the Givens will +win. The Wanteds don't need much fuel: we are only expanding at all +to expose functional dependencies, and wantedFuel=1 means we will +expand a full recursive layer. If the superclass hierarchy is +non-recursive (the normal case) one layer is therefore full expansion. + +The default value for wantedFuel = Constants.max_WANTEDS_FUEL = 1. +The default value for givenFuel = Constants.max_GIVENS_FUEL = 3. +Both are configurable via the `-fgivens-fuel` and `-fwanteds-fuel` +compiler flags. + +There are two preconditions for the default fuel values: + (1) default givenFuel >= default wantedsFuel + (2) default givenFuel < solverIterations + +Precondition (1) ensures that we expand givens atleast as many times as we expand wanted constraints +preferably givenFuel > wantedsFuel to avoid issues like T21909 while +the precondition (2) ensures that we do not reach the solver iteration limit and fail with a +more meaningful error message + +This also applies for quantified constraints; see `-fqcs-fuel` compiler flag and `QCI.qci_pend_sc` field. +-} + + solveNestedImplications :: Bag Implication -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -59,7 +59,7 @@ import Control.Monad import Data.Maybe ( isJust, isNothing ) import Data.List ( zip4 ) import GHC.Types.Basic - +import GHC.Driver.Session ( givensFuel, wantedsFuel, qcsFuel ) import qualified Data.Semigroup as S import Data.Bifunctor ( bimap ) @@ -154,9 +154,13 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys doNotExpand } + -- doNotExpand: We have already expanded superclasses for /this/ dict + -- so set the fuel to doNotExpand to avoid repeating expansion | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -168,7 +172,7 @@ canClassNC ev cls tys -- and Note [Solving CallStack constraints] in GHC.Tc.Solver.Types = do { -- First we emit a new constraint that will capture the -- given CallStack. - ; let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) + let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) -- We change the origin to IPOccOrigin so -- this rule does not fire again. -- See Note [Overview of implicit CallStacks] @@ -182,14 +186,20 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys doNotExpand + -- doNotExpand: No superclasses for class CallStack + -- See invariants in CDictCan.cc_pend_sc } | otherwise - = canClass ev cls tys (has_scs cls) + = do { dflags <- getDynFlags + ; let fuel | classHasSCs cls = wantedsFuel dflags + | otherwise = doNotExpand + -- See Invariants in `CCDictCan.cc_pend_sc` + ; canClass ev cls tys fuel + } where - has_scs cls = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -206,7 +216,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -307,10 +317,11 @@ So here's the plan: 4. Go round to (2) again. This loop (2,3,4) is implemented in GHC.Tc.Solver.simpl_loop. -The cc_pend_sc flag in a CDictCan records whether the superclasses of +The cc_pend_sc field in a CDictCan records whether the superclasses of this constraint have been expanded. Specifically, in Step 3 we only -expand superclasses for constraints with cc_pend_sc set to true (i.e. -isPendingScDict holds). +expand superclasses for constraints with cc_pend_sc > 0 +(i.e. isPendingScDict holds). +See Note [Expanding Recursive Superclasses and ExpansionFuel] Why do we do this? Two reasons: @@ -337,7 +348,8 @@ our strategy. Consider f :: C a => a -> Bool f x = x==x Then canClassNC gets the [G] d1: C a constraint, and eager emits superclasses -G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its sc_pend flag set.) +G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its cc_pend_sc has pending +expansion fuel.) When processing d3 we find a match with d1 in the inert set, and we always keep the inert item (d1) if possible: see Note [Replacement vs keeping] in GHC.Tc.Solver.Interact. So d3 dies a quick, happy death. @@ -484,7 +496,6 @@ the sc_theta_ids at all. So our final construction is makeSuperClasses :: [Ct] -> TcS [Ct] -- Returns strict superclasses, transitively, see Note [The superclass story] --- See Note [The superclass story] -- The loop-breaking here follows Note [Expanding superclasses] in GHC.Tc.Utils.TcType -- Specifically, for an incoming (C t) constraint, we return all of (C t)'s -- superclasses, up to /and including/ the first repetition of C @@ -493,39 +504,45 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- class C [a] => D a -- makeSuperClasses (C x) will return (D x, C [x]) -- --- NB: the incoming constraints have had their cc_pend_sc flag already --- flipped to False, by isPendingScDict, so we are /obliged/ to at --- least produce the immediate superclasses +-- NB: the incoming constraint's superclass will consume a unit of fuel +-- Preconditions on `cts`: 1. They are either `CDictCan` or `CQuantCan` +-- 2. Their fuel (stored in cc_pend_sc or qci_pend_sc) is > 0 makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys - go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev [] [] cls tys + go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +-- Precondition: fuel > 0 +-- Postcondition: fuel for recursive superclass ct is one unit less than cls fuel +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses (consumeFuel fuel) (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +-- The caller of this function is supposed to perform fuel book keeping +-- Precondition: fuel >= 0 +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -543,7 +560,8 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; assertFuelPrecondition fuel + $ mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -604,7 +622,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -619,7 +637,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -634,46 +652,53 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +-- Precondition: fuel >= 0 +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = assertFuelPrecondition fuel $ + mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +-- Precondition: fuel >= 0 +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) - ; return [this_ct] } -- cc_pend_sc of this_ct = True + ; assertFuelPrecondition fuel $ return [mk_this_ct fuel] } + -- cc_pend_sc of returning ct = fuel | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys - ; return (this_ct : sc_cts) } - -- cc_pend_sc of this_ct = False + ; sc_cts <- assertFuelPrecondition fuel $ + mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys + ; return (mk_this_ct doNotExpand : sc_cts) } + -- doNotExpand: we have expanded this cls's superclasses, so + -- exhaust the associated constraint's fuel, + -- to avoid duplicate work where cls_nm = className cls loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm - - this_ct | null tvs, null theta - = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } - -- NB: If there is a loop, we cut off, so we have not - -- added the superclasses, hence cc_pend_sc = True - | otherwise - = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys - , qci_ev = ev - , qci_pend_sc = loop_found }) + mk_this_ct :: ExpansionFuel -> Ct + mk_this_ct fuel | null tvs, null theta + = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys + , cc_pend_sc = fuel } + -- NB: If there is a loop, we cut off, so we have not + -- added the superclasses, hence cc_pend_sc = fuel + | otherwise + = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys + , qci_ev = ev + , qci_pend_sc = fuel }) {- Note [Equality superclasses in quantified constraints] @@ -828,19 +853,28 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev tvs theta cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canForAll ev False } + ; canForAll ev doNotExpand } + -- doNotExpand: as we have already (eagerly) expanded superclasses for this class | otherwise - = canForAll ev (isJust cls_pred_tys_maybe) - + = do { dflags <- getDynFlags + ; let fuel | Just (cls, _) <- cls_pred_tys_maybe + , classHasSCs cls = qcsFuel dflags + -- See invariants (a) and (b) in QCI.qci_pend_sc + -- qcsFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + -- See Note [Quantified constraints] + | otherwise = doNotExpand + ; canForAll ev fuel } where cls_pred_tys_maybe = getClassPredTys_maybe pred -canForAll :: CtEvidence -> Bool -> TcS (StopOrContinue Ct) +canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) -- We have a constraint (forall as. blah => C tys) -canForAll ev pend_sc +canForAll ev fuel = do { -- First rewrite it to apply the current substitution let pred = ctEvPred ev ; (redn, rewriters) <- rewrite ev pred @@ -850,14 +884,14 @@ canForAll ev pend_sc -- (It takes a lot less code to rewrite before decomposing.) ; case classifyPredType (ctEvPred new_ev) of ForAllPred tvs theta pred - -> solveForAll new_ev tvs theta pred pend_sc + -> solveForAll new_ev tvs theta pred fuel _ -> pprPanic "canForAll" (ppr new_ev) } } -solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> Bool +solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel -> TcS (StopOrContinue Ct) solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) - tvs theta pred _pend_sc + tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] setLclEnv (ctLocEnv loc) $ -- This setLclEnv is important: the emitImplicationTcS uses that @@ -903,12 +937,12 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo _ -> pSizeType pred -- See Note [Solving a Given forall-constraint] -solveForAll ev@(CtGiven {}) tvs _theta pred pend_sc +solveForAll ev@(CtGiven {}) tvs _theta pred fuel = do { addInertForAll qci ; stopWith ev "Given forall-constraint" } where qci = QCI { qci_ev = ev, qci_tvs = tvs - , qci_pred = pred, qci_pend_sc = pend_sc } + , qci_pred = pred, qci_pend_sc = fuel } {- Note [Solving a Wanted forall-constraint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -513,10 +513,13 @@ getInertGivens ; return (filter isGivenCt all_cts) } getPendingGivenScs :: TcS [Ct] --- Find all inert Given dictionaries, or quantified constraints, --- whose cc_pend_sc flag is True --- and that belong to the current level --- Set their cc_pend_sc flag to False in the inert set, and return that Ct +-- Find all inert Given dictionaries, or quantified constraints, such that +-- 1. cc_pend_sc flag has fuel strictly > 0 +-- 2. belongs to the current level +-- For each such dictionary: +-- * Return it (with unmodified cc_pend_sc) in sc_pending +-- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand +-- to record that we have expanded superclasses for this dict getPendingGivenScs = do { lvl <- getTcLevel ; updRetInertCans (get_sc_pending lvl) } @@ -530,29 +533,33 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) sc_pending = sc_pend_insts ++ sc_pend_dicts sc_pend_dicts = foldDicts get_pending dicts [] - dicts' = foldr add dicts sc_pend_dicts + dicts' = foldr exhaustAndAdd dicts sc_pend_dicts (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts - | Just dict' <- pendingScDict_maybe dict + | isPendingScDict dict , belongs_to_this_level (ctEvidence dict) - = dict' : dicts + = dict : dicts | otherwise = dicts - add :: Ct -> DictMap Ct -> DictMap Ct - add ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts - = addDict dicts cls tys ct - add ct _ = pprPanic "getPendingScDicts" (ppr ct) + exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct + exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts + -- exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) + exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) get_pending_inst cts qci@(QCI { qci_ev = ev }) | Just qci' <- pendingScInst_maybe qci , belongs_to_this_level ev - = (CQuantCan qci' : cts, qci') + = (CQuantCan qci : cts, qci') + -- qci' have their fuel exhausted + -- we don't want to expand these constraints again + -- qci is expanded | otherwise = (cts, qci) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,6 +11,8 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, + ExpansionFuel, doNotExpand, consumeFuel, pendingFuel, + assertFuelPrecondition, assertFuelPreconditionStrict, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -138,8 +140,6 @@ import Data.Word ( Word8 ) import Data.List ( intersperse ) - - {- ************************************************************************ * * @@ -191,6 +191,37 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- Invariant: ExpansionFuel should always be >= 0 +-- see Note [Expanding Recursive Superclasses and ExpansionFuel] +type ExpansionFuel = Int + +-- | Do not expand superclasses any further +doNotExpand :: ExpansionFuel +doNotExpand = 0 + +-- | Consumes one unit of fuel. +-- Precondition: fuel > 0 +consumeFuel :: ExpansionFuel -> ExpansionFuel +consumeFuel fuel = assertFuelPreconditionStrict fuel $ fuel - 1 + +-- | Returns True if we have any fuel left for superclass expansion +pendingFuel :: ExpansionFuel -> Bool +pendingFuel n = n > 0 + +insufficientFuelError :: SDoc +insufficientFuelError = text "Superclass expansion fuel should be > 0" + +-- | asserts if fuel is non-negative +assertFuelPrecondition :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPrecondition #-} +assertFuelPrecondition fuel = assertPpr (fuel >= 0) insufficientFuelError + +-- | asserts if fuel is strictly greater than 0 +assertFuelPreconditionStrict :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPreconditionStrict #-} +assertFuelPreconditionStrict fuel = assertPpr (pendingFuel fuel) insufficientFuelError + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,11 +230,12 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those - -- superclasses as Givens + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver + -- Invariants: cc_pend_sc > 0 <=> + -- (a) cc_class has superclasses + -- (b) those superclasses are not yet explored } | CIrredCan { -- These stand for yet-unusable predicates @@ -273,8 +305,13 @@ data QCInst -- A much simplified version of ClsInst -- Always Given , qci_tvs :: [TcTyVar] -- The tvs , qci_pred :: TcPredType -- The ty - , qci_pend_sc :: Bool -- Same as cc_pend_sc flag in CDictCan - -- Invariant: True => qci_pred is a ClassPred + , qci_pend_sc :: ExpansionFuel + -- Invariants: qci_pend_sc > 0 => + -- (a) qci_pred is a ClassPred + -- (b) this class has superclass(es), and + -- (c) the superclass(es) are not explored yet + -- Same as cc_pend_sc flag in CDictCan + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver } instance Outputable QCInst where @@ -673,11 +710,11 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason - CQuantCan (QCI { qci_pend_sc = pend_sc }) - | pend_sc -> text "CQuantCan(psc)" + CQuantCan (QCI { qci_pend_sc = psc }) + | psc > 0 -> text "CQuantCan" <> parens (text "psc" <+> ppr psc) | otherwise -> text "CQuantCan" ----------------------------------- @@ -893,23 +930,24 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = f }) = pendingFuel f +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, --- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, +-- AND if so exhausts the fuel so that they are not expanded again +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = f }) + | pendingFuel f = Just (ct { cc_pend_sc = doNotExpand }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst -- Same as isPendingScDict, but for QCInsts -pendingScInst_maybe qci@(QCI { qci_pend_sc = True }) - = Just (qci { qci_pend_sc = False }) -pendingScInst_maybe _ = Nothing +pendingScInst_maybe qci@(QCI { qci_pend_sc = f }) + | pendingFuel f = Just (qci { qci_pend_sc = doNotExpand }) + | otherwise = Nothing superClassesMightHelp :: WantedConstraints -> Bool -- ^ True if taking superclasses of givens, or of wanteds (to perhaps @@ -928,11 +966,12 @@ superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics }) is_ip _ = False getPendingWantedScs :: Cts -> ([Ct], Cts) +-- in the return values [Ct] has original fuel while Cts has fuel exhausted getPendingWantedScs simples = mapAccumBagL get [] simples where - get acc ct | Just ct' <- pendingScDict_maybe ct - = (ct':acc, ct') + get acc ct | Just ct_exhausted <- pendingScDict_maybe ct + = (ct:acc, ct_exhausted) | otherwise = (acc, ct) ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -33,6 +33,9 @@ -fbang-patterns -fbuilding-cabal-package -fconstraint-solver-iterations +-fgivens-expansion-fuel +-fwanteds-expansion-fuel +-fqcs-expansion-fuel -fcontext-stack -fcross-module-specialize -fdiagnostics-color=always ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +class C [a] => C a where + foo :: a -> Int + +bar :: C a => a -> Int +bar x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -864,3 +864,5 @@ test('T22924', normal, compile, ['']) test('T22985a', normal, compile, ['-O']) test('T22985b', normal, compile, ['']) test('T23018', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e5f4727e4857d73d1cac539f90b70b2a51040dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e5f4727e4857d73d1cac539f90b70b2a51040dc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 13:50:32 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 06 Mar 2023 08:50:32 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/no-this-unit-id-ghc Message-ID: <6405efa88f9b3_3ab52b5f0985309101f6@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/no-this-unit-id-ghc at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/no-this-unit-id-ghc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 14:41:22 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 06 Mar 2023 09:41:22 -0500 Subject: [Git][ghc/ghc][wip/T21909] Constraint simplification loop now depends on `ExpansionFuel` Message-ID: <6405fb92404be_3ab52b5f92593c9192e7@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: f5c3ae02 by Apoorv Ingle at 2023-03-06T08:40:40-06:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - 11 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - docs/users_guide/expected-undocumented-flags.txt - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Class.hs ===================================== @@ -17,8 +17,8 @@ module GHC.Core.Class ( mkClass, mkAbstractClass, classTyVars, classArity, classKey, className, classATs, classATItems, classTyCon, classMethods, classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta, - classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, classHasFds, - isAbstractClass, + classHasSCs, classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, + classHasFds, isAbstractClass, ) where import GHC.Prelude @@ -295,6 +295,9 @@ classSCTheta (Class { classBody = ConcreteClass { cls_sc_theta = theta_stuff }}) = theta_stuff classSCTheta _ = [] +classHasSCs :: Class -> Bool +classHasSCs cls = not (null (classSCTheta cls)) + classTvsFds :: Class -> ([TyVar], [FunDep TyVar]) classTvsFds c = (classTyVars c, classFunDeps c) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -517,7 +517,15 @@ data DynFlags = DynFlags { reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver -- Typically only 1 is needed - + givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens + -- Should be < solverIterations + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] homeUnitId_ :: UnitId, -- ^ Target home unit-id homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations @@ -1148,6 +1156,9 @@ defaultDynFlags mySettings = mainFunIs = Nothing, reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, homeUnitId_ = mainUnitId, homeUnitInstanceOf_ = Nothing, @@ -2733,6 +2744,12 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n })) , make_ord_flag defFlag "fconstraint-solver-iterations" (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n })) + , make_ord_flag defFlag "fgivens-expansion-fuel" + (intSuffix (\n d -> d { givensFuel = n })) + , make_ord_flag defFlag "fwanteds-expansion-fuel" + (intSuffix (\n d -> d { wantedsFuel = n })) + , make_ord_flag defFlag "fqcs-expansion-fuel" + (intSuffix (\n d -> d { qcsFuel = n })) , (Deprecated, defFlag "fcontext-stack" (intSuffixM (\n d -> do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead" ===================================== compiler/GHC/Settings/Constants.hs ===================================== @@ -30,6 +30,27 @@ mAX_REDUCTION_DEPTH = 200 mAX_SOLVER_ITERATIONS :: Int mAX_SOLVER_ITERATIONS = 4 +-- | In case of loopy quantified costraints constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_QC_FUEL :: Int +mAX_QC_FUEL = 3 + +-- | In case of loopy wanted constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_GIVENS_FUEL +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_WANTEDS_FUEL :: Int +mAX_WANTEDS_FUEL = 1 + +-- | In case of loopy given constraints, +-- how many times should we allow superclass expansions +-- Should be less than max_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_GIVENS_FUEL :: Int +mAX_GIVENS_FUEL = 3 + wORD64_SIZE :: Int wORD64_SIZE = 8 ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2338,6 +2338,10 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set + ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given + , text "new_given" <+> ppr new_given + , text "pending_wanted" <+> ppr pending_wanted + , text "new_wanted" <+> ppr new_wanted ]) ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } -- (not (null pending_given)): see Note [Superclass iteration] @@ -2366,6 +2370,73 @@ superclasses. In that case we check whether the new Wanteds actually led to any new unifications, and iterate the implications only if so. -} +{- Note [Expanding Recursive Superclasses and ExpansionFuel] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the class declaration (T21909) + + class C [a] => C a where + foo :: a -> Int + +and suppose during type inference we obtain an implication constraint: + + forall a. C a => C [[a]] + +To solve this implication constraint, we first expand one layer of the superclass +of Given constraints, but not for Wanted constraints. +(See Note [Eagerly expand given superclasses] and Note [Why adding superclasses can help] +in GHC.Tc.Solver.Canonical.) We thus get: + + [G] g1 :: C a + [G] g2 :: C [a] -- new superclass layer from g1 + [W] w1 :: C [[a]] + +Now, we cannot solve `w1` directly from `g1` or `g2` as we may not have +any instances for C. So we expand a layer of superclasses of each Wanteds and Givens +that we haven't expanded yet. +This is done in `maybe_simplify_again`. And we get: + + [G] g1 :: C a + [G] g2 :: C [a] + [G] g3 :: C [[a]] -- new superclass layer from g2, can solve w1 + [W] w1 :: C [[a]] + [W] w2 :: C [[[a]]] -- new superclass layer from w1, not solvable + +Now, although we can solve `w1` using `g3` (obtained from expanding `g2`), +we have a new wanted constraint `w2` (obtained from expanding `w1`) that cannot be solved. +We thus make another go at solving in `maybe_simplify_again` by expanding more +layers of superclasses. This looping is futile as Givens will never be able to catch up with Wanteds. + +Side Note: In principle we don't actually need to /solve/ `w2`, as it is a superclass of `w1` +but we only expand it to expose any functional dependencies (see Note [The superclass story]) +But `w2` is a wanted constraint, so we will try to solve it like any other, +even though ultimately we will discard its evidence. + +Solution: Simply bound the maximum number of layers of expansion for +Givens and Wanteds, with ExpansionFuel. Give the Givens more fuel +(say 3 layers) than the Wanteds (say 1 layer). Now the Givens will +win. The Wanteds don't need much fuel: we are only expanding at all +to expose functional dependencies, and wantedFuel=1 means we will +expand a full recursive layer. If the superclass hierarchy is +non-recursive (the normal case) one layer is therefore full expansion. + +The default value for wantedFuel = Constants.max_WANTEDS_FUEL = 1. +The default value for givenFuel = Constants.max_GIVENS_FUEL = 3. +Both are configurable via the `-fgivens-fuel` and `-fwanteds-fuel` +compiler flags. + +There are two preconditions for the default fuel values: + (1) default givenFuel >= default wantedsFuel + (2) default givenFuel < solverIterations + +Precondition (1) ensures that we expand givens at least as many times as we expand wanted constraints +preferably givenFuel > wantedsFuel to avoid issues like T21909 while +the precondition (2) ensures that we do not reach the solver iteration limit and fail with a +more meaningful error message + +This also applies for quantified constraints; see `-fqcs-fuel` compiler flag and `QCI.qci_pend_sc` field. +-} + + solveNestedImplications :: Bag Implication -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -59,7 +59,7 @@ import Control.Monad import Data.Maybe ( isJust, isNothing ) import Data.List ( zip4 ) import GHC.Types.Basic - +import GHC.Driver.Session ( givensFuel, wantedsFuel, qcsFuel ) import qualified Data.Semigroup as S import Data.Bifunctor ( bimap ) @@ -154,9 +154,13 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys doNotExpand } + -- doNotExpand: We have already expanded superclasses for /this/ dict + -- so set the fuel to doNotExpand to avoid repeating expansion | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -168,7 +172,7 @@ canClassNC ev cls tys -- and Note [Solving CallStack constraints] in GHC.Tc.Solver.Types = do { -- First we emit a new constraint that will capture the -- given CallStack. - ; let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) + let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) -- We change the origin to IPOccOrigin so -- this rule does not fire again. -- See Note [Overview of implicit CallStacks] @@ -182,14 +186,20 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys doNotExpand + -- doNotExpand: No superclasses for class CallStack + -- See invariants in CDictCan.cc_pend_sc } | otherwise - = canClass ev cls tys (has_scs cls) + = do { dflags <- getDynFlags + ; let fuel | classHasSCs cls = wantedsFuel dflags + | otherwise = doNotExpand + -- See Invariants in `CCDictCan.cc_pend_sc` + ; canClass ev cls tys fuel + } where - has_scs cls = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -206,7 +216,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -307,10 +317,11 @@ So here's the plan: 4. Go round to (2) again. This loop (2,3,4) is implemented in GHC.Tc.Solver.simpl_loop. -The cc_pend_sc flag in a CDictCan records whether the superclasses of +The cc_pend_sc field in a CDictCan records whether the superclasses of this constraint have been expanded. Specifically, in Step 3 we only -expand superclasses for constraints with cc_pend_sc set to true (i.e. -isPendingScDict holds). +expand superclasses for constraints with cc_pend_sc > 0 +(i.e. isPendingScDict holds). +See Note [Expanding Recursive Superclasses and ExpansionFuel] Why do we do this? Two reasons: @@ -337,7 +348,8 @@ our strategy. Consider f :: C a => a -> Bool f x = x==x Then canClassNC gets the [G] d1: C a constraint, and eager emits superclasses -G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its sc_pend flag set.) +G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its cc_pend_sc has pending +expansion fuel.) When processing d3 we find a match with d1 in the inert set, and we always keep the inert item (d1) if possible: see Note [Replacement vs keeping] in GHC.Tc.Solver.Interact. So d3 dies a quick, happy death. @@ -484,7 +496,6 @@ the sc_theta_ids at all. So our final construction is makeSuperClasses :: [Ct] -> TcS [Ct] -- Returns strict superclasses, transitively, see Note [The superclass story] --- See Note [The superclass story] -- The loop-breaking here follows Note [Expanding superclasses] in GHC.Tc.Utils.TcType -- Specifically, for an incoming (C t) constraint, we return all of (C t)'s -- superclasses, up to /and including/ the first repetition of C @@ -493,39 +504,45 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- class C [a] => D a -- makeSuperClasses (C x) will return (D x, C [x]) -- --- NB: the incoming constraints have had their cc_pend_sc flag already --- flipped to False, by isPendingScDict, so we are /obliged/ to at --- least produce the immediate superclasses +-- NB: the incoming constraint's superclass will consume a unit of fuel +-- Preconditions on `cts`: 1. They are either `CDictCan` or `CQuantCan` +-- 2. Their fuel (stored in cc_pend_sc or qci_pend_sc) is > 0 makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys - go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev [] [] cls tys + go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +-- Precondition: fuel > 0 +-- Postcondition: fuel for recursive superclass ct is one unit less than cls fuel +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses (consumeFuel fuel) (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +-- The caller of this function is supposed to perform fuel book keeping +-- Precondition: fuel >= 0 +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -543,7 +560,8 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; assertFuelPrecondition fuel + $ mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -604,7 +622,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -619,7 +637,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -634,46 +652,53 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +-- Precondition: fuel >= 0 +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = assertFuelPrecondition fuel $ + mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +-- Precondition: fuel >= 0 +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) - ; return [this_ct] } -- cc_pend_sc of this_ct = True + ; assertFuelPrecondition fuel $ return [mk_this_ct fuel] } + -- cc_pend_sc of returning ct = fuel | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys - ; return (this_ct : sc_cts) } - -- cc_pend_sc of this_ct = False + ; sc_cts <- assertFuelPrecondition fuel $ + mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys + ; return (mk_this_ct doNotExpand : sc_cts) } + -- doNotExpand: we have expanded this cls's superclasses, so + -- exhaust the associated constraint's fuel, + -- to avoid duplicate work where cls_nm = className cls loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm - - this_ct | null tvs, null theta - = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } - -- NB: If there is a loop, we cut off, so we have not - -- added the superclasses, hence cc_pend_sc = True - | otherwise - = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys - , qci_ev = ev - , qci_pend_sc = loop_found }) + mk_this_ct :: ExpansionFuel -> Ct + mk_this_ct fuel | null tvs, null theta + = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys + , cc_pend_sc = fuel } + -- NB: If there is a loop, we cut off, so we have not + -- added the superclasses, hence cc_pend_sc = fuel + | otherwise + = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys + , qci_ev = ev + , qci_pend_sc = fuel }) {- Note [Equality superclasses in quantified constraints] @@ -828,19 +853,28 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev tvs theta cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canForAll ev False } + ; canForAll ev doNotExpand } + -- doNotExpand: as we have already (eagerly) expanded superclasses for this class | otherwise - = canForAll ev (isJust cls_pred_tys_maybe) - + = do { dflags <- getDynFlags + ; let fuel | Just (cls, _) <- cls_pred_tys_maybe + , classHasSCs cls = qcsFuel dflags + -- See invariants (a) and (b) in QCI.qci_pend_sc + -- qcsFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + -- See Note [Quantified constraints] + | otherwise = doNotExpand + ; canForAll ev fuel } where cls_pred_tys_maybe = getClassPredTys_maybe pred -canForAll :: CtEvidence -> Bool -> TcS (StopOrContinue Ct) +canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) -- We have a constraint (forall as. blah => C tys) -canForAll ev pend_sc +canForAll ev fuel = do { -- First rewrite it to apply the current substitution let pred = ctEvPred ev ; (redn, rewriters) <- rewrite ev pred @@ -850,14 +884,14 @@ canForAll ev pend_sc -- (It takes a lot less code to rewrite before decomposing.) ; case classifyPredType (ctEvPred new_ev) of ForAllPred tvs theta pred - -> solveForAll new_ev tvs theta pred pend_sc + -> solveForAll new_ev tvs theta pred fuel _ -> pprPanic "canForAll" (ppr new_ev) } } -solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> Bool +solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel -> TcS (StopOrContinue Ct) solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) - tvs theta pred _pend_sc + tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] setLclEnv (ctLocEnv loc) $ -- This setLclEnv is important: the emitImplicationTcS uses that @@ -903,12 +937,12 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo _ -> pSizeType pred -- See Note [Solving a Given forall-constraint] -solveForAll ev@(CtGiven {}) tvs _theta pred pend_sc +solveForAll ev@(CtGiven {}) tvs _theta pred fuel = do { addInertForAll qci ; stopWith ev "Given forall-constraint" } where qci = QCI { qci_ev = ev, qci_tvs = tvs - , qci_pred = pred, qci_pend_sc = pend_sc } + , qci_pred = pred, qci_pend_sc = fuel } {- Note [Solving a Wanted forall-constraint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -513,10 +513,13 @@ getInertGivens ; return (filter isGivenCt all_cts) } getPendingGivenScs :: TcS [Ct] --- Find all inert Given dictionaries, or quantified constraints, --- whose cc_pend_sc flag is True --- and that belong to the current level --- Set their cc_pend_sc flag to False in the inert set, and return that Ct +-- Find all inert Given dictionaries, or quantified constraints, such that +-- 1. cc_pend_sc flag has fuel strictly > 0 +-- 2. belongs to the current level +-- For each such dictionary: +-- * Return it (with unmodified cc_pend_sc) in sc_pending +-- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand +-- to record that we have expanded superclasses for this dict getPendingGivenScs = do { lvl <- getTcLevel ; updRetInertCans (get_sc_pending lvl) } @@ -530,29 +533,33 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) sc_pending = sc_pend_insts ++ sc_pend_dicts sc_pend_dicts = foldDicts get_pending dicts [] - dicts' = foldr add dicts sc_pend_dicts + dicts' = foldr exhaustAndAdd dicts sc_pend_dicts (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts - | Just dict' <- pendingScDict_maybe dict + | isPendingScDict dict , belongs_to_this_level (ctEvidence dict) - = dict' : dicts + = dict : dicts | otherwise = dicts - add :: Ct -> DictMap Ct -> DictMap Ct - add ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts - = addDict dicts cls tys ct - add ct _ = pprPanic "getPendingScDicts" (ppr ct) + exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct + exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts + -- exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) + exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) get_pending_inst cts qci@(QCI { qci_ev = ev }) | Just qci' <- pendingScInst_maybe qci , belongs_to_this_level ev - = (CQuantCan qci' : cts, qci') + = (CQuantCan qci : cts, qci') + -- qci' have their fuel exhausted + -- we don't want to expand these constraints again + -- qci is expanded | otherwise = (cts, qci) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,6 +11,8 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, + ExpansionFuel, doNotExpand, consumeFuel, pendingFuel, + assertFuelPrecondition, assertFuelPreconditionStrict, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -138,8 +140,6 @@ import Data.Word ( Word8 ) import Data.List ( intersperse ) - - {- ************************************************************************ * * @@ -191,6 +191,37 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- Invariant: ExpansionFuel should always be >= 0 +-- see Note [Expanding Recursive Superclasses and ExpansionFuel] +type ExpansionFuel = Int + +-- | Do not expand superclasses any further +doNotExpand :: ExpansionFuel +doNotExpand = 0 + +-- | Consumes one unit of fuel. +-- Precondition: fuel > 0 +consumeFuel :: ExpansionFuel -> ExpansionFuel +consumeFuel fuel = assertFuelPreconditionStrict fuel $ fuel - 1 + +-- | Returns True if we have any fuel left for superclass expansion +pendingFuel :: ExpansionFuel -> Bool +pendingFuel n = n > 0 + +insufficientFuelError :: SDoc +insufficientFuelError = text "Superclass expansion fuel should be > 0" + +-- | asserts if fuel is non-negative +assertFuelPrecondition :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPrecondition #-} +assertFuelPrecondition fuel = assertPpr (fuel >= 0) insufficientFuelError + +-- | asserts if fuel is strictly greater than 0 +assertFuelPreconditionStrict :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPreconditionStrict #-} +assertFuelPreconditionStrict fuel = assertPpr (pendingFuel fuel) insufficientFuelError + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,11 +230,12 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those - -- superclasses as Givens + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver + -- Invariants: cc_pend_sc > 0 <=> + -- (a) cc_class has superclasses + -- (b) those superclasses are not yet explored } | CIrredCan { -- These stand for yet-unusable predicates @@ -273,8 +305,13 @@ data QCInst -- A much simplified version of ClsInst -- Always Given , qci_tvs :: [TcTyVar] -- The tvs , qci_pred :: TcPredType -- The ty - , qci_pend_sc :: Bool -- Same as cc_pend_sc flag in CDictCan - -- Invariant: True => qci_pred is a ClassPred + , qci_pend_sc :: ExpansionFuel + -- Invariants: qci_pend_sc > 0 => + -- (a) qci_pred is a ClassPred + -- (b) this class has superclass(es), and + -- (c) the superclass(es) are not explored yet + -- Same as cc_pend_sc flag in CDictCan + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver } instance Outputable QCInst where @@ -673,11 +710,11 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason - CQuantCan (QCI { qci_pend_sc = pend_sc }) - | pend_sc -> text "CQuantCan(psc)" + CQuantCan (QCI { qci_pend_sc = psc }) + | psc > 0 -> text "CQuantCan" <> parens (text "psc" <+> ppr psc) | otherwise -> text "CQuantCan" ----------------------------------- @@ -893,23 +930,24 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = f }) = pendingFuel f +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, --- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, +-- AND if so exhausts the fuel so that they are not expanded again +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = f }) + | pendingFuel f = Just (ct { cc_pend_sc = doNotExpand }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst -- Same as isPendingScDict, but for QCInsts -pendingScInst_maybe qci@(QCI { qci_pend_sc = True }) - = Just (qci { qci_pend_sc = False }) -pendingScInst_maybe _ = Nothing +pendingScInst_maybe qci@(QCI { qci_pend_sc = f }) + | pendingFuel f = Just (qci { qci_pend_sc = doNotExpand }) + | otherwise = Nothing superClassesMightHelp :: WantedConstraints -> Bool -- ^ True if taking superclasses of givens, or of wanteds (to perhaps @@ -928,11 +966,12 @@ superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics }) is_ip _ = False getPendingWantedScs :: Cts -> ([Ct], Cts) +-- in the return values [Ct] has original fuel while Cts has fuel exhausted getPendingWantedScs simples = mapAccumBagL get [] simples where - get acc ct | Just ct' <- pendingScDict_maybe ct - = (ct':acc, ct') + get acc ct | Just ct_exhausted <- pendingScDict_maybe ct + = (ct:acc, ct_exhausted) | otherwise = (acc, ct) ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -33,6 +33,9 @@ -fbang-patterns -fbuilding-cabal-package -fconstraint-solver-iterations +-fgivens-expansion-fuel +-fwanteds-expansion-fuel +-fqcs-expansion-fuel -fcontext-stack -fcross-module-specialize -fdiagnostics-color=always ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +class C [a] => C a where + foo :: a -> Int + +bar :: C a => a -> Int +bar x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -864,3 +864,5 @@ test('T22924', normal, compile, ['']) test('T22985a', normal, compile, ['-O']) test('T22985b', normal, compile, ['']) test('T23018', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5c3ae02d74d94d3183f288fb70a076babf338b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5c3ae02d74d94d3183f288fb70a076babf338b2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 15:03:17 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 06 Mar 2023 10:03:17 -0500 Subject: [Git][ghc/ghc][wip/romes/no-this-unit-id-ghc] working this out Message-ID: <640600b518246_3ab52b601969cc920887@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/no-this-unit-id-ghc at Glasgow Haskell Compiler / GHC Commits: 66cc9306 by romes at 2023-03-06T15:02:59+00:00 working this out - - - - - 11 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Debug.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -198,317 +198,319 @@ names with uniques. These ones are the *non* wired-in ones. The wired in ones are defined in GHC.Builtin.Types etc. -} -basicKnownKeyNames :: [Name] -- See Note [Known-key names] +basicKnownKeyNames :: IO [Name] -- See Note [Known-key names] basicKnownKeyNames - = genericTyConNames - ++ [ -- Classes. *Must* include: - -- classes that are grabbed by key (e.g., eqClassKey) - -- classes in "Class.standardClassKeys" (quite a few) - eqClassName, -- mentioned, derivable - ordClassName, -- derivable - boundedClassName, -- derivable - numClassName, -- mentioned, numeric - enumClassName, -- derivable - monadClassName, - functorClassName, - realClassName, -- numeric - integralClassName, -- numeric - fractionalClassName, -- numeric - floatingClassName, -- numeric - realFracClassName, -- numeric - realFloatClassName, -- numeric - dataClassName, - isStringClassName, - applicativeClassName, - alternativeClassName, - foldableClassName, - traversableClassName, - semigroupClassName, sappendName, - monoidClassName, memptyName, mappendName, mconcatName, - - -- The IO type - ioTyConName, ioDataConName, - runMainIOName, - runRWName, - - -- Type representation types - trModuleTyConName, trModuleDataConName, - trNameTyConName, trNameSDataConName, trNameDDataConName, - trTyConTyConName, trTyConDataConName, - - -- Typeable - typeableClassName, - typeRepTyConName, - someTypeRepTyConName, - someTypeRepDataConName, - kindRepTyConName, - kindRepTyConAppDataConName, - kindRepVarDataConName, - kindRepAppDataConName, - kindRepFunDataConName, - kindRepTYPEDataConName, - kindRepTypeLitSDataConName, - kindRepTypeLitDDataConName, - typeLitSortTyConName, - typeLitSymbolDataConName, - typeLitNatDataConName, - typeLitCharDataConName, - typeRepIdName, - mkTrTypeName, - mkTrConName, - mkTrAppName, - mkTrFunName, - typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName, - trGhcPrimModuleName, - - -- KindReps for common cases - starKindRepName, - starArrStarKindRepName, - starArrStarArrStarKindRepName, - constraintKindRepName, - - -- WithDict - withDictClassName, - - -- Dynamic - toDynName, - - -- Numeric stuff - negateName, minusName, geName, eqName, - mkRationalBase2Name, mkRationalBase10Name, - - -- Conversion functions - rationalTyConName, - ratioTyConName, ratioDataConName, - fromRationalName, fromIntegerName, - toIntegerName, toRationalName, - fromIntegralName, realToFracName, - - -- Int# stuff - divIntName, modIntName, - - -- String stuff - fromStringName, - - -- Enum stuff - enumFromName, enumFromThenName, - enumFromThenToName, enumFromToName, - - -- Applicative stuff - pureAName, apAName, thenAName, - - -- Functor stuff - fmapName, - - -- Monad stuff - thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName, - returnMName, joinMName, - - -- MonadFail - monadFailClassName, failMName, - - -- MonadFix - monadFixClassName, mfixName, - - -- Arrow stuff - arrAName, composeAName, firstAName, - appAName, choiceAName, loopAName, - - -- Ix stuff - ixClassName, - - -- Show stuff - showClassName, - - -- Read stuff - readClassName, - - -- Stable pointers - newStablePtrName, - - -- GHC Extensions - considerAccessibleName, - - -- Strings and lists - unpackCStringName, unpackCStringUtf8Name, - unpackCStringAppendName, unpackCStringAppendUtf8Name, - unpackCStringFoldrName, unpackCStringFoldrUtf8Name, - cstringLengthName, - - -- Overloaded lists - isListClassName, - fromListName, - fromListNName, - toListName, - - -- Non-empty lists - nonEmptyTyConName, - - -- Overloaded record dot, record update - getFieldName, setFieldName, - - -- List operations - concatName, filterName, mapName, - zipName, foldrName, buildName, augmentName, appendName, - - -- FFI primitive types that are not wired-in. - stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName, - int8TyConName, int16TyConName, int32TyConName, int64TyConName, - word8TyConName, word16TyConName, word32TyConName, word64TyConName, - - -- Others - otherwiseIdName, inlineIdName, - eqStringName, assertName, - assertErrorName, traceName, - printName, - dollarName, - - -- ghc-bignum - integerFromNaturalName, - integerToNaturalClampName, - integerToNaturalThrowName, - integerToNaturalName, - integerToWordName, - integerToIntName, - integerToWord64Name, - integerToInt64Name, - integerFromWordName, - integerFromWord64Name, - integerFromInt64Name, - integerAddName, - integerMulName, - integerSubName, - integerNegateName, - integerAbsName, - integerPopCountName, - integerQuotName, - integerRemName, - integerDivName, - integerModName, - integerDivModName, - integerQuotRemName, - integerEncodeFloatName, - integerEncodeDoubleName, - integerGcdName, - integerLcmName, - integerAndName, - integerOrName, - integerXorName, - integerComplementName, - integerBitName, - integerTestBitName, - integerShiftLName, - integerShiftRName, - - naturalToWordName, - naturalPopCountName, - naturalShiftRName, - naturalShiftLName, - naturalAddName, - naturalSubName, - naturalSubThrowName, - naturalSubUnsafeName, - naturalMulName, - naturalQuotRemName, - naturalQuotName, - naturalRemName, - naturalAndName, - naturalAndNotName, - naturalOrName, - naturalXorName, - naturalTestBitName, - naturalBitName, - naturalGcdName, - naturalLcmName, - naturalLog2Name, - naturalLogBaseWordName, - naturalLogBaseName, - naturalPowModName, - naturalSizeInBaseName, - - bignatFromWordListName, - bignatEqName, - - -- Float/Double - integerToFloatName, - integerToDoubleName, - naturalToFloatName, - naturalToDoubleName, - rationalToFloatName, - rationalToDoubleName, - - -- Other classes - monadPlusClassName, - - -- Type-level naturals - knownNatClassName, knownSymbolClassName, knownCharClassName, - - -- Overloaded labels - fromLabelClassOpName, - - -- Implicit Parameters - ipClassName, - - -- Overloaded record fields - hasFieldClassName, - - -- Call Stacks - callStackTyConName, - emptyCallStackName, pushCallStackName, - - -- Source Locations - srcLocDataConName, - - -- Annotation type checking - toAnnotationWrapperName - - -- The SPEC type for SpecConstr - , specTyConName - - -- The Either type - , eitherTyConName, leftDataConName, rightDataConName - - -- The Void type - , voidTyConName - + = sequence [ -- Plugins - , pluginTyConName + pluginTyConName , frontendPluginTyConName - - -- Generics - , genClassName, gen1ClassName - , datatypeClassName, constructorClassName, selectorClassName - - -- Monad comprehensions - , guardMName - , liftMName - , mzipName - - -- GHCi Sandbox - , ghciIoClassName, ghciStepIoMName - - -- StaticPtr - , makeStaticName - , staticPtrTyConName - , staticPtrDataConName, staticPtrInfoDataConName - , fromStaticPtrName - - -- Fingerprint - , fingerprintDataConName - - -- Custom type errors - , errorMessageTypeErrorFamName - , typeErrorTextDataConName - , typeErrorAppendDataConName - , typeErrorVAppendDataConName - , typeErrorShowTypeDataConName - - -- Unsafe coercion proofs - , unsafeEqualityProofName - , unsafeEqualityTyConName - , unsafeReflDataConName - , unsafeCoercePrimName - ] + ] >>= \ioknownnames -> + pure (ioknownnames ++ + genericTyConNames + ++ [ -- Classes. *Must* include: + -- classes that are grabbed by key (e.g., eqClassKey) + -- classes in "Class.standardClassKeys" (quite a few) + eqClassName, -- mentioned, derivable + ordClassName, -- derivable + boundedClassName, -- derivable + numClassName, -- mentioned, numeric + enumClassName, -- derivable + monadClassName, + functorClassName, + realClassName, -- numeric + integralClassName, -- numeric + fractionalClassName, -- numeric + floatingClassName, -- numeric + realFracClassName, -- numeric + realFloatClassName, -- numeric + dataClassName, + isStringClassName, + applicativeClassName, + alternativeClassName, + foldableClassName, + traversableClassName, + semigroupClassName, sappendName, + monoidClassName, memptyName, mappendName, mconcatName, + + -- The IO type + ioTyConName, ioDataConName, + runMainIOName, + runRWName, + + -- Type representation types + trModuleTyConName, trModuleDataConName, + trNameTyConName, trNameSDataConName, trNameDDataConName, + trTyConTyConName, trTyConDataConName, + + -- Typeable + typeableClassName, + typeRepTyConName, + someTypeRepTyConName, + someTypeRepDataConName, + kindRepTyConName, + kindRepTyConAppDataConName, + kindRepVarDataConName, + kindRepAppDataConName, + kindRepFunDataConName, + kindRepTYPEDataConName, + kindRepTypeLitSDataConName, + kindRepTypeLitDDataConName, + typeLitSortTyConName, + typeLitSymbolDataConName, + typeLitNatDataConName, + typeLitCharDataConName, + typeRepIdName, + mkTrTypeName, + mkTrConName, + mkTrAppName, + mkTrFunName, + typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName, + trGhcPrimModuleName, + + -- KindReps for common cases + starKindRepName, + starArrStarKindRepName, + starArrStarArrStarKindRepName, + constraintKindRepName, + + -- WithDict + withDictClassName, + + -- Dynamic + toDynName, + + -- Numeric stuff + negateName, minusName, geName, eqName, + mkRationalBase2Name, mkRationalBase10Name, + + -- Conversion functions + rationalTyConName, + ratioTyConName, ratioDataConName, + fromRationalName, fromIntegerName, + toIntegerName, toRationalName, + fromIntegralName, realToFracName, + + -- Int# stuff + divIntName, modIntName, + + -- String stuff + fromStringName, + + -- Enum stuff + enumFromName, enumFromThenName, + enumFromThenToName, enumFromToName, + + -- Applicative stuff + pureAName, apAName, thenAName, + + -- Functor stuff + fmapName, + + -- Monad stuff + thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName, + returnMName, joinMName, + + -- MonadFail + monadFailClassName, failMName, + + -- MonadFix + monadFixClassName, mfixName, + + -- Arrow stuff + arrAName, composeAName, firstAName, + appAName, choiceAName, loopAName, + + -- Ix stuff + ixClassName, + + -- Show stuff + showClassName, + + -- Read stuff + readClassName, + + -- Stable pointers + newStablePtrName, + + -- GHC Extensions + considerAccessibleName, + + -- Strings and lists + unpackCStringName, unpackCStringUtf8Name, + unpackCStringAppendName, unpackCStringAppendUtf8Name, + unpackCStringFoldrName, unpackCStringFoldrUtf8Name, + cstringLengthName, + + -- Overloaded lists + isListClassName, + fromListName, + fromListNName, + toListName, + + -- Non-empty lists + nonEmptyTyConName, + + -- Overloaded record dot, record update + getFieldName, setFieldName, + + -- List operations + concatName, filterName, mapName, + zipName, foldrName, buildName, augmentName, appendName, + + -- FFI primitive types that are not wired-in. + stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName, + int8TyConName, int16TyConName, int32TyConName, int64TyConName, + word8TyConName, word16TyConName, word32TyConName, word64TyConName, + + -- Others + otherwiseIdName, inlineIdName, + eqStringName, assertName, + assertErrorName, traceName, + printName, + dollarName, + + -- ghc-bignum + integerFromNaturalName, + integerToNaturalClampName, + integerToNaturalThrowName, + integerToNaturalName, + integerToWordName, + integerToIntName, + integerToWord64Name, + integerToInt64Name, + integerFromWordName, + integerFromWord64Name, + integerFromInt64Name, + integerAddName, + integerMulName, + integerSubName, + integerNegateName, + integerAbsName, + integerPopCountName, + integerQuotName, + integerRemName, + integerDivName, + integerModName, + integerDivModName, + integerQuotRemName, + integerEncodeFloatName, + integerEncodeDoubleName, + integerGcdName, + integerLcmName, + integerAndName, + integerOrName, + integerXorName, + integerComplementName, + integerBitName, + integerTestBitName, + integerShiftLName, + integerShiftRName, + + naturalToWordName, + naturalPopCountName, + naturalShiftRName, + naturalShiftLName, + naturalAddName, + naturalSubName, + naturalSubThrowName, + naturalSubUnsafeName, + naturalMulName, + naturalQuotRemName, + naturalQuotName, + naturalRemName, + naturalAndName, + naturalAndNotName, + naturalOrName, + naturalXorName, + naturalTestBitName, + naturalBitName, + naturalGcdName, + naturalLcmName, + naturalLog2Name, + naturalLogBaseWordName, + naturalLogBaseName, + naturalPowModName, + naturalSizeInBaseName, + + bignatFromWordListName, + bignatEqName, + + -- Float/Double + integerToFloatName, + integerToDoubleName, + naturalToFloatName, + naturalToDoubleName, + rationalToFloatName, + rationalToDoubleName, + + -- Other classes + monadPlusClassName, + + -- Type-level naturals + knownNatClassName, knownSymbolClassName, knownCharClassName, + + -- Overloaded labels + fromLabelClassOpName, + + -- Implicit Parameters + ipClassName, + + -- Overloaded record fields + hasFieldClassName, + + -- Call Stacks + callStackTyConName, + emptyCallStackName, pushCallStackName, + + -- Source Locations + srcLocDataConName, + + -- Annotation type checking + toAnnotationWrapperName + + -- The SPEC type for SpecConstr + , specTyConName + + -- The Either type + , eitherTyConName, leftDataConName, rightDataConName + + -- The Void type + , voidTyConName + + -- Generics + , genClassName, gen1ClassName + , datatypeClassName, constructorClassName, selectorClassName + + -- Monad comprehensions + , guardMName + , liftMName + , mzipName + + -- GHCi Sandbox + , ghciIoClassName, ghciStepIoMName + + -- StaticPtr + , makeStaticName + , staticPtrTyConName + , staticPtrDataConName, staticPtrInfoDataConName + , fromStaticPtrName + + -- Fingerprint + , fingerprintDataConName + + -- Custom type errors + , errorMessageTypeErrorFamName + , typeErrorTextDataConName + , typeErrorAppendDataConName + , typeErrorVAppendDataConName + , typeErrorShowTypeDataConName + + -- Unsafe coercion proofs + , unsafeEqualityProofName + , unsafeEqualityTyConName + , unsafeReflDataConName + , unsafeCoercePrimName + ]) genericTyConNames :: [Name] genericTyConNames = [ @@ -1631,12 +1633,12 @@ srcLocDataConName = dcQual gHC_STACK_TYPES (fsLit "SrcLoc") srcLocDataConKey -- plugins -pLUGINS :: Module -pLUGINS = mkThisGhcModule (fsLit "GHC.Driver.Plugins") -pluginTyConName :: Name -pluginTyConName = tcQual pLUGINS (fsLit "Plugin") pluginTyConKey -frontendPluginTyConName :: Name -frontendPluginTyConName = tcQual pLUGINS (fsLit "FrontendPlugin") frontendPluginTyConKey +pLUGINS :: IO Module +pLUGINS = pure $ mkThisGhcModule (fsLit "GHC.Driver.Plugins") +pluginTyConName :: IO Name +pluginTyConName = pLUGINS >>= \plugin_mod -> pure (tcQual plugin_mod (fsLit "Plugin") pluginTyConKey) +frontendPluginTyConName :: IO Name +frontendPluginTyConName = pLUGINS >>= \plugin_mod -> pure (tcQual plugin_mod (fsLit "FrontendPlugin") frontendPluginTyConKey) -- Static pointers makeStaticName :: Name ===================================== compiler/GHC/Builtin/Utils.hs ===================================== @@ -113,7 +113,7 @@ Note [About wired-in things] -- | This list is used to ensure that when you say "Prelude.map" in your source -- code, or in an interface file, you get a Name with the correct known key (See -- Note [Known-key names] in "GHC.Builtin.Names") -knownKeyNames :: [Name] +knownKeyNames :: IO [Name] knownKeyNames | debugIsOn , Just badNamesStr <- knownKeyNamesOkay all_names @@ -123,7 +123,7 @@ knownKeyNames -- "<
>" error. (This seems to happen only in the -- stage 2 compiler, for reasons I [Richard] have no clue of.) | otherwise - = all_names + = (++) all_names <$> basicKnownKeyNames where all_names = concat [ concatMap wired_tycon_kk_names primTyCons @@ -132,7 +132,6 @@ knownKeyNames , map idName wiredInIds , map idName allThePrimOpIds , map (idName . primOpWrapperId) allThePrimOps - , basicKnownKeyNames , templateHaskellNames ] -- All of the names associated with a wired-in TyCon. @@ -189,22 +188,22 @@ knownKeyNamesOkay all_names -- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a -- known-key thing. -lookupKnownKeyName :: Unique -> Maybe Name +lookupKnownKeyName :: Unique -> IO (Maybe Name) lookupKnownKeyName u = - knownUniqueName u <|> lookupUFM_Directly knownKeysMap u + (knownUniqueName u <|>) . flip lookupUFM_Directly u <$> knownKeysMap -- | Is a 'Name' known-key? -isKnownKeyName :: Name -> Bool +isKnownKeyName :: Name -> IO Bool isKnownKeyName n = - isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap + (isJust (knownUniqueName $ nameUnique n) ||) . elemUFM n <$> knownKeysMap -- | Maps 'Unique's to known-key names. -- -- The type is @UniqFM Name Name@ to denote that the 'Unique's used -- in the domain are 'Unique's associated with 'Name's (as opposed -- to some other namespace of 'Unique's). -knownKeysMap :: UniqFM Name Name -knownKeysMap = listToIdentityUFM knownKeyNames +knownKeysMap :: IO (UniqFM Name Name) +knownKeysMap = listToIdentityUFM <$> knownKeyNames -- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by -- GHCi's ':info' command. ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -305,7 +305,8 @@ newHscEnv top_dir dflags = newHscEnvWithHUG top_dir dflags (homeUnitId_ dflags) newHscEnvWithHUG :: FilePath -> DynFlags -> UnitId -> HomeUnitGraph -> IO HscEnv newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do - nc_var <- initNameCache 'r' knownKeyNames + knownKeyNames' <- knownKeyNames + nc_var <- initNameCache 'r' knownKeyNames' fc_var <- initFinderCache logger <- initLogger tmpfs <- initTmpFs ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE BinaryLiterals, ScopedTypeVariables #-} +{-# LANGUAGE BinaryLiterals, ScopedTypeVariables, LambdaCase #-} -- -- (c) The University of Glasgow 2002-2006 @@ -336,18 +336,17 @@ putName _dict BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } bh name - | isKnownKeyName name - , let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits = -- assert (u < 2^(22 :: Int)) - put_ bh (0x80000000 - .|. (fromIntegral (ord c) `shiftL` 22) - .|. (fromIntegral u :: Word32)) - - | otherwise - = do symtab_map <- readIORef symtab_map_ref - case lookupUFM symtab_map name of - Just (off,_) -> put_ bh (fromIntegral off :: Word32) - Nothing -> do + isKnownKeyName name >>= \case + True -> let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits + in put_ bh (0x80000000 + .|. (fromIntegral (ord c) `shiftL` 22) + .|. (fromIntegral u :: Word32)) + False -> do + symtab_map <- readIORef symtab_map_ref + case lookupUFM symtab_map name of + Just (off,_) -> put_ bh (fromIntegral off :: Word32) + Nothing -> do off <- readFastMutInt symtab_next -- massert (off < 2^(30 :: Int)) writeFastMutInt symtab_next (off+1) @@ -370,10 +369,10 @@ getSymtabName _name_cache _dict symtab bh = do ix = fromIntegral i .&. 0x003FFFFF u = mkUnique tag ix in - return $! case lookupKnownKeyName u of - Nothing -> pprPanic "getSymtabName:unknown known-key unique" - (ppr i $$ ppr u $$ char tag $$ ppr ix) - Just n -> n + lookupKnownKeyName u >>= \case + Nothing -> pprPanic "getSymtabName:unknown known-key unique" + (ppr i $$ ppr u $$ char tag $$ ppr ix) + Just n -> return $! n _ -> pprPanic "getSymtabName:unknown name tag" (ppr i) ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -3,6 +3,7 @@ Binary serialization for .hie files. -} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} module GHC.Iface.Ext.Binary ( readHieFile @@ -291,15 +292,18 @@ putName (HieSymbolTable next ref) bh name = do let hieName = ExternalName mod occ (nameSrcSpan name) writeIORef ref $! addToUFM symmap name (off, hieName) put_ bh (fromIntegral off :: Word32) - Just (off, LocalName _occ span) - | notLocal (toHieName name) || nameSrcSpan name /= span -> do - writeIORef ref $! addToUFM symmap name (off, toHieName name) - put_ bh (fromIntegral off :: Word32) + Just (off, LocalName _occ span) -> do + hieName <- toHieName name + if notLocal (hieName) || nameSrcSpan name /= span then do + writeIORef ref $! addToUFM symmap name (off, hieName) + put_ bh (fromIntegral off :: Word32) + else put_ bh (fromIntegral off :: Word32) -- ROMES:TODO can we not duplicate this here as below? Just (off, _) -> put_ bh (fromIntegral off :: Word32) Nothing -> do + hieName <- toHieName name off <- readFastMutInt next writeFastMutInt next (off+1) - writeIORef ref $! addToUFM symmap name (off, toHieName name) + writeIORef ref $! addToUFM symmap name (off, hieName) put_ bh (fromIntegral off :: Word32) where @@ -328,7 +332,7 @@ fromHieName nc hie_name = do -- don't update the NameCache for local names pure $ mkInternalName uniq occ span - KnownKeyName u -> case lookupKnownKeyName u of + KnownKeyName u -> lookupKnownKeyName u >>= \case Nothing -> pprPanic "fromHieName:unknown known-key unique" (ppr u) Just n -> pure n ===================================== compiler/GHC/Iface/Ext/Debug.hs ===================================== @@ -22,6 +22,8 @@ import qualified Data.Set as S import Data.Function ( on ) import Data.List ( sortOn ) +import System.IO.Unsafe ( unsafePerformIO ) + type Diff a = a -> a -> [SDoc] diffFile :: Diff HieFile @@ -64,10 +66,10 @@ diffAst diffType (Node info1 span1 xs1) (Node info2 span2 xs2) = type DiffIdent = Either ModuleName HieName normalizeIdents :: Ord a => NodeIdentifiers a -> [(DiffIdent,IdentifierDetails a)] -normalizeIdents = sortOn go . map (first toHieName) . M.toList +normalizeIdents = sortOn go . map (first (unsafePerformIO . toHieName)) . M.toList where first f (a,b) = (fmap f a, b) - go (a,b) = (hieNameOcc <$> a,identInfo b,identType b) + go (a,b) = (unsafePerformIO . hieNameOcc <$> a,identInfo b,identType b) diffList :: Diff a -> Diff [a] diffList f xs ys ===================================== compiler/GHC/Iface/Ext/Types.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} @@ -42,6 +43,8 @@ import Data.Coerce ( coerce ) import Data.Function ( on ) import qualified Data.Semigroup as S +import System.IO.Unsafe ( unsafePerformIO ) + type Span = RealSrcSpan -- | Current version of @.hie@ files @@ -581,10 +584,10 @@ newtype EvBindDeps = EvBindDeps { getEvBindDeps :: [Name] } deriving Outputable instance Eq EvBindDeps where - (==) = coerce ((==) `on` map toHieName) + (==) = coerce ((==) `on` map (unsafePerformIO . toHieName)) instance Ord EvBindDeps where - compare = coerce (compare `on` map toHieName) + compare = coerce (compare `on` map (unsafePerformIO . toHieName)) instance Binary EvBindDeps where put_ bh (EvBindDeps xs) = put_ bh xs @@ -767,19 +770,25 @@ instance Outputable HieName where ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u -hieNameOcc :: HieName -> OccName -hieNameOcc (ExternalName _ occ _) = occ -hieNameOcc (LocalName occ _) = occ +-- Why do we need IO? See Note [Looking up known key names] +hieNameOcc :: HieName -> IO OccName +hieNameOcc (ExternalName _ occ _) = pure occ +hieNameOcc (LocalName occ _) = pure occ hieNameOcc (KnownKeyName u) = - case lookupKnownKeyName u of - Just n -> nameOccName n + lookupKnownKeyName u >>= \case + Just n -> pure (nameOccName n) Nothing -> pprPanic "hieNameOcc:unknown known-key unique" (ppr u) -toHieName :: Name -> HieName -toHieName name - | isKnownKeyName name = KnownKeyName (nameUnique name) - | isExternalName name = ExternalName (nameModule name) - (nameOccName name) - (removeBufSpan $ nameSrcSpan name) - | otherwise = LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name) +-- Why do we need IO? See Note [Looking up known key names] +toHieName :: Name -> IO HieName +toHieName name = + isKnownKeyName name >>= \case + True -> pure (KnownKeyName (nameUnique name)) + False + | isExternalName name -> + pure $ ExternalName (nameModule name) + (nameOccName name) + (removeBufSpan $ nameSrcSpan name) + | otherwise -> + pure $ LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name) ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -138,15 +138,17 @@ loadPlugins hsc_env where options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags , opt_mod_nm == mod_nm ] - loadPlugin = loadPlugin' (mkVarOccFS (fsLit "plugin")) pluginTyConName hsc_env + loadPlugin p = pluginTyConName >>= \pluginTyConName' -> loadPlugin' (mkVarOccFS (fsLit "plugin")) pluginTyConName' hsc_env p loadFrontendPlugin :: HscEnv -> ModuleName -> IO (FrontendPlugin, [Linkable], PkgsLoaded) loadFrontendPlugin hsc_env mod_name = do checkExternalInterpreter hsc_env (plugin, _iface, links, pkgs) - <- loadPlugin' (mkVarOccFS (fsLit "frontendPlugin")) frontendPluginTyConName - hsc_env mod_name + <- frontendPluginTyConName >>= + \frontendPluginTCN -> + loadPlugin' (mkVarOccFS (fsLit "frontendPlugin")) frontendPluginTCN + hsc_env mod_name return (plugin, links, pkgs) -- #14335 @@ -168,7 +170,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name [ text "The module", ppr mod_name , text "did not export the plugin name" , ppr plugin_rdr_name ]) ; - Just (name, mod_iface) -> + Just (name, mod_iface) -> pprTrace "ROMES: Current unit" (ppr . ue_current_unit . hsc_unit_env $ hsc_env) $ do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name ; eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) ===================================== compiler/GHC/Tc/Errors/Hole.hs ===================================== @@ -597,6 +597,7 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _ ; traceTc "hole_lvl is:" $ ppr hole_lvl ; traceTc "simples are: " $ ppr simples ; traceTc "locals are: " $ ppr lclBinds + ; builtIns' <- liftIO builtIns ; let (lcl, gbl) = partition gre_lcl (globalRdrEnvElts rdr_env) -- We remove binding shadowings here, but only for the local level. -- this is so we e.g. suggest the global fmap from the Functor class @@ -605,7 +606,7 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _ locals = removeBindingShadowing $ map IdHFCand lclBinds ++ map GreHFCand lcl globals = map GreHFCand gbl - syntax = map NameHFCand builtIns + syntax = map NameHFCand builtIns' -- If the hole is a rigid type-variable, then we only check the -- locals, since only they can match the type (in a meaningful way). only_locals = any isImmutableTyVar $ getTyVar_maybe hole_ty @@ -663,8 +664,8 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _ hole_lvl = ctLocLevel ct_loc -- BuiltInSyntax names like (:) and [] - builtIns :: [Name] - builtIns = filter isBuiltInSyntax knownKeyNames + builtIns :: IO [Name] + builtIns = filter isBuiltInSyntax <$> knownKeyNames -- We make a refinement type by adding a new type variable in front -- of the type of t h hole, going from e.g. [Integer] -> Integer ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -108,6 +108,7 @@ import GHC.Utils.Exception import System.Directory import System.FilePath as FilePath import Control.Monad +import Data.IORef import Data.Graph (stronglyConnComp, SCC(..)) import Data.Char ( toUpper ) import Data.List ( intersperse, partition, sortBy, isSuffixOf ) @@ -410,7 +411,7 @@ type ModuleNameProvidersMap = Map ModuleName (Map Module ModuleOrigin) data UnitState = UnitState { - -- | A mapping of 'Unit' to 'UnitInfo'. This list is adjusted + -- | A mapping of 'UnitId' to 'UnitInfo'. This list is adjusted -- so that only valid units are here. 'UnitInfo' reflects -- what was stored *on disk*, except for the 'trusted' flag, which -- is adjusted at runtime. (In particular, some units in this map @@ -430,6 +431,7 @@ data UnitState = UnitState { -- And also to resolve package qualifiers with the PackageImports extension. packageNameMap :: UniqFM PackageName UnitId, + -- TODO: Remove these two completely? -- | A mapping from database unit keys to wired in unit ids. wireMap :: Map UnitId UnitId, @@ -1096,8 +1098,9 @@ findWiredInUnits logger prec_map pkgs vis_map = do -- their canonical names (eg. base-1.0 ==> base), as described -- in Note [Wired-in units] in GHC.Unit.Types let - matches :: UnitInfo -> UnitId -> Bool - pc `matches` pid = unitPackageName pc == PackageName (unitIdFS pid) + -- Match a package name against a UnitInfo + matches :: UnitInfo -> FastString -> Bool + pc `matches` pname = unitPackageName pc == PackageName pname -- find which package corresponds to each wired-in package -- delete any other packages with the same name @@ -1116,10 +1119,10 @@ findWiredInUnits logger prec_map pkgs vis_map = do -- this works even when there is no exposed wired in package -- available. -- - findWiredInUnit :: [UnitInfo] -> UnitId -> IO (Maybe (UnitId, UnitInfo)) - findWiredInUnit pkgs wired_pkg = firstJustsM [try all_exposed_ps, try all_ps, notfound] + findWiredInUnitByName :: [UnitInfo] -> FastString -> IO (Maybe (FastString, UnitInfo)) + findWiredInUnitByName pkgs wired_pkg_name = firstJustsM [try all_exposed_ps, try all_ps, notfound] -- ROMES:TODO: In fact, here we ? where - all_ps = [ p | p <- pkgs, p `matches` wired_pkg ] + all_ps = [ p | p <- pkgs, p `matches` wired_pkg_name ] all_exposed_ps = [ p | p <- all_ps, Map.member (mkUnit p) vis_map ] try ps = case sortByPreference prec_map ps of @@ -1129,26 +1132,27 @@ findWiredInUnits logger prec_map pkgs vis_map = do notfound = do debugTraceMsg logger 2 $ text "wired-in package " - <> ftext (unitIdFS wired_pkg) + <> ftext wired_pkg_name <> text " not found." return Nothing - pick :: UnitInfo -> IO (UnitId, UnitInfo) + + pick :: UnitInfo -> IO (FastString, UnitInfo) pick pkg = do debugTraceMsg logger 2 $ text "wired-in package " - <> ftext (unitIdFS wired_pkg) + <> ftext wired_pkg_name <> text " mapped to " <> ppr (unitId pkg) - return (wired_pkg, pkg) + return (wired_pkg_name, pkg) - mb_wired_in_pkgs <- mapM (findWiredInUnit pkgs) wiredInUnitIds + mb_wired_in_pkgs <- mapM (findWiredInUnitByName pkgs) wiredInUnitNames let wired_in_pkgs = catMaybes mb_wired_in_pkgs wiredInMap :: Map UnitId UnitId wiredInMap = Map.fromList - [ (unitId realUnitInfo, wiredInUnitId) + [ (unitId realUnitInfo, UnitId wiredInUnitId) | (wiredInUnitId, realUnitInfo) <- wired_in_pkgs , not (unitIsIndefinite realUnitInfo) ] @@ -1608,6 +1612,7 @@ mkUnitState logger cfg = do -- package arguments we need to key against the old versions. -- (pkgs2, wired_map) <- findWiredInUnits logger prec_map pkgs1 vis_map2 + let pkg_db = mkUnitInfoMap pkgs2 -- Update the visibility map, so we treat wired packages as visible. @@ -1696,6 +1701,8 @@ mkUnitState logger cfg = do , requirementContext = req_ctx , allowVirtualUnits = unitConfigAllowVirtual cfg } + + writeIORef workingThisOut (unwireMap state) return (state, raw_dbs) selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -24,6 +24,8 @@ module GHC.Unit.Types , pprInstantiatedModule , moduleFreeHoles + , workingThisOut + -- * Units , IsUnitId , GenUnit (..) @@ -79,7 +81,7 @@ module GHC.Unit.Types , interactiveUnit , isInteractiveModule - , wiredInUnitIds + , wiredInUnitNames -- * Boot modules , IsBootInterface (..) @@ -105,12 +107,23 @@ import Data.Data import Data.List (sortBy ) import Data.Function import Data.Bifunctor +import Data.IORef +import Data.Map (Map) +import qualified Data.Map as Map import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS.Char8 +import System.IO.Unsafe + import Language.Haskell.Syntax.Module.Name import {-# SOURCE #-} Language.Haskell.Syntax.ImpExp (IsBootInterface(..)) +-- Ref for an "unwireMap" which maps wired-in ids to actual units, created by +-- identifying wired-in packages in the list of package-id flags +workingThisOut :: IORef (Map UnitId UnitId) +workingThisOut = unsafePerformIO (newIORef (Map.singleton (UnitId $ fsLit "ouch-version") (UnitId $ fsLit "ouch"))) +{-# NOINLINE workingThisOut #-} + --------------------------------------------------------------------- -- MODULES --------------------------------------------------------------------- @@ -587,19 +600,35 @@ Make sure you change 'GHC.Unit.State.findWiredInUnits' if you add an entry here. -} +bignumUnitName, primUnitName, baseUnitName, rtsUnitName, + thUnitName, mainUnitName, thisGhcUnitName, interactiveUnitName :: FastString + bignumUnitId, primUnitId, baseUnitId, rtsUnitId, thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId bignumUnit, primUnit, baseUnit, rtsUnit, thUnit, mainUnit, thisGhcUnit, interactiveUnit :: Unit -primUnitId = UnitId (fsLit "ghc-prim") -bignumUnitId = UnitId (fsLit "ghc-bignum") -baseUnitId = UnitId (fsLit "base") -rtsUnitId = UnitId (fsLit "rts") -thisGhcUnitId = UnitId (fsLit "ghc") -interactiveUnitId = UnitId (fsLit "interactive") -thUnitId = UnitId (fsLit "template-haskell") +primUnitName = fsLit "ghc-prim" +bignumUnitName = fsLit "ghc-bignum" +baseUnitName = fsLit "base" +rtsUnitName = fsLit "rts" +thisGhcUnitName = fsLit "ghc" +interactiveUnitName = fsLit "interactive" +thUnitName = fsLit "template-haskell" + +primUnitId = UnitId primUnitName +bignumUnitId = UnitId bignumUnitName +baseUnitId = UnitId baseUnitName +rtsUnitId = UnitId rtsUnitName +thisGhcUnitId = UnitId thisGhcUnitName +interactiveUnitId = UnitId interactiveUnitName +thUnitId = mkWiredInUnitId thUnitName +{-# INLINE bignumUnitId #-} +{-# INLINE baseUnitId #-} +{-# INLINE rtsUnitId #-} +{-# INLINE thisGhcUnitId #-} +{-# INLINE thUnitId #-} thUnit = RealUnit (Definite thUnitId) primUnit = RealUnit (Definite primUnitId) @@ -612,20 +641,28 @@ interactiveUnit = RealUnit (Definite interactiveUnitId) -- | This is the package Id for the current program. It is the default -- package Id if you don't specify a package name. We don't add this prefix -- to symbol names, since there can be only one main package per program. -mainUnitId = UnitId (fsLit "main") +mainUnitName = fsLit "main" +mainUnitId = UnitId mainUnitName mainUnit = RealUnit (Definite mainUnitId) +-- Make the actual unit id the result of looking up the wired-in unit package name in the wire map +mkWiredInUnitId :: FastString -> UnitId +mkWiredInUnitId x = case Map.lookup (UnitId x) $ unsafePerformIO (readIORef workingThisOut) of + Nothing -> pprTrace "Romes:Couldn't find UnitId" (ppr (UnitId x,unsafePerformIO (readIORef workingThisOut))) (UnitId $ fsLit "rts") -- this is a fallback, in which situations do we need a fallback? perhaps when booting the compiler with the rts? + Just y -> pprTrace "Romes:Found in wire map" (ppr x <+> text "->" <> ppr y) y + + isInteractiveModule :: Module -> Bool isInteractiveModule mod = moduleUnit mod == interactiveUnit -wiredInUnitIds :: [UnitId] -wiredInUnitIds = - [ primUnitId - , bignumUnitId - , baseUnitId - , rtsUnitId - , thUnitId - , thisGhcUnitId +wiredInUnitNames :: [FastString] +wiredInUnitNames = + [ primUnitName + , bignumUnitName + , baseUnitName + , rtsUnitName + , thUnitName + , thisGhcUnitName ] --------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66cc93063f94ed3110eccd789268ee38fdc11443 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66cc93063f94ed3110eccd789268ee38fdc11443 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 17:01:04 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 06 Mar 2023 12:01:04 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/no-this-unit-id-aggressive Message-ID: <64061c50b8cd1_3ab52b6255a53494082a@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/no-this-unit-id-aggressive at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/no-this-unit-id-aggressive You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 17:01:37 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 06 Mar 2023 12:01:37 -0500 Subject: [Git][ghc/ghc][wip/romes/no-this-unit-id-aggressive] Aggressive deletion Message-ID: <64061c719023d_3ab52b6255a4a8941096@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/no-this-unit-id-aggressive at Glasgow Haskell Compiler / GHC Commits: 22036aa2 by romes at 2023-03-06T17:01:23+00:00 Aggressive deletion - - - - - 4 changed files: - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs - + del-this-unit-id.sh Changes: ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -235,8 +235,7 @@ withBkpSession cid insts deps session_type do_this = do , importPaths = [] -- Synthesize the flags , packageFlags = packageFlags dflags ++ map (\(uid0, rn) -> - let uid = unwireUnit unit_state - $ improveUnit unit_state + let uid = improveUnit unit_state $ renameHoleUnit unit_state (listToUFM insts) uid0 in ExposePackage (showSDoc dflags @@ -372,7 +371,7 @@ buildUnit session cid insts lunit = do -- really used for anything, so we leave it -- blank for now. TcSession -> [] - _ -> map (toUnitId . unwireUnit state) + _ -> map toUnitId $ deps ++ [ moduleUnit mod | (_, mod) <- insts , not (isHoleModule mod) ], ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -69,7 +69,6 @@ module GHC.Unit.State ( pprWithUnitState, -- * Utils - unwireUnit, implicitPackageDeps) where @@ -431,13 +430,6 @@ data UnitState = UnitState { -- And also to resolve package qualifiers with the PackageImports extension. packageNameMap :: UniqFM PackageName UnitId, - -- TODO: Remove these two completely? - -- | A mapping from database unit keys to wired in unit ids. - wireMap :: Map UnitId UnitId, - - -- | A mapping from wired in unit ids to unit keys from the database. - unwireMap :: Map UnitId UnitId, - -- | The units we're going to link in eagerly. This list -- should be in reverse dependency order; that is, a unit -- is always mentioned before the units it depends on. @@ -480,8 +472,6 @@ emptyUnitState = UnitState { unitInfoMap = Map.empty, preloadClosure = emptyUniqSet, packageNameMap = emptyUFM, - wireMap = Map.empty, - unwireMap = Map.empty, preloadUnits = [], explicitUnits = [], homeUnitDepends = [], @@ -673,13 +663,8 @@ mkHomeUnit -> Maybe UnitId -- ^ Home unit instance of -> [(ModuleName, Module)] -- ^ Home unit instantiations -> HomeUnit -mkHomeUnit unit_state hu_id hu_instanceof hu_instantiations_ = - let - -- Some wired units can be used to instantiate the home unit. We need to - -- replace their unit keys with their wired unit ids. - wmap = wireMap unit_state - hu_instantiations = map (fmap (upd_wired_in_mod wmap)) hu_instantiations_ - in case (hu_instanceof, hu_instantiations) of +mkHomeUnit unit_state hu_id hu_instanceof hu_instantiations = + case (hu_instanceof, hu_instantiations) of (Nothing,[]) -> DefiniteHomeUnit hu_id Nothing (Nothing, _) -> throwGhcException $ CmdLineError ("Use of -instantiated-with requires -this-component-id") (Just _, []) -> throwGhcException $ CmdLineError ("Use of -this-component-id requires -instantiated-with") @@ -1082,7 +1067,7 @@ pprTrustFlag flag = case flag of -- -- See Note [Wired-in units] in GHC.Unit.Types -type WiringMap = Map UnitId UnitId +type WiringMap = Map WiredInPackageName UnitId findWiredInUnits :: Logger @@ -1119,8 +1104,8 @@ findWiredInUnits logger prec_map pkgs vis_map = do -- this works even when there is no exposed wired in package -- available. -- - findWiredInUnitByName :: [UnitInfo] -> FastString -> IO (Maybe (FastString, UnitInfo)) - findWiredInUnitByName pkgs wired_pkg_name = firstJustsM [try all_exposed_ps, try all_ps, notfound] -- ROMES:TODO: In fact, here we ? + findWiredInUnitByName :: [UnitInfo] -> WiredInPackageName -> IO (Maybe (FastString, UnitInfo)) + findWiredInUnitByName pkgs (WiredInPackageName wired_pkg_name) = firstJustsM [try all_exposed_ps, try all_ps, notfound] -- ROMES:TODO: In fact, here we ? where all_ps = [ p | p <- pkgs, p `matches` wired_pkg_name ] all_exposed_ps = [ p | p <- all_ps, Map.member (mkUnit p) vis_map ] @@ -1150,65 +1135,45 @@ findWiredInUnits logger prec_map pkgs vis_map = do let wired_in_pkgs = catMaybes mb_wired_in_pkgs - wiredInMap :: Map UnitId UnitId + wiredInMap :: Map WiredInPackageName UnitId wiredInMap = Map.fromList - [ (unitId realUnitInfo, UnitId wiredInUnitId) - | (wiredInUnitId, realUnitInfo) <- wired_in_pkgs + [ (WiredInPackageName wiredInUnitName, unitId realUnitInfo) + | (wiredInUnitName, realUnitInfo) <- wired_in_pkgs , not (unitIsIndefinite realUnitInfo) ] - updateWiredInDependencies pkgs = map (upd_deps . upd_pkg) pkgs - where upd_pkg pkg - | Just wiredInUnitId <- Map.lookup (unitId pkg) wiredInMap - = pkg { unitId = wiredInUnitId - , unitInstanceOf = wiredInUnitId - -- every non instantiated unit is an instance of - -- itself (required by Backpack...) - -- - -- See Note [About units] in GHC.Unit - } - | otherwise - = pkg - upd_deps pkg = pkg { - unitDepends = map (upd_wired_in wiredInMap) (unitDepends pkg), - unitExposedModules - = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v)) - (unitExposedModules pkg) - } - - - return (updateWiredInDependencies pkgs, wiredInMap) - --- Helper functions for rewiring Module and Unit. These --- rewrite Units of modules in wired-in packages to the form known to the --- compiler, as described in Note [Wired-in units] in GHC.Unit.Types. --- --- For instance, base-4.9.0.0 will be rewritten to just base, to match --- what appears in GHC.Builtin.Names. - -upd_wired_in_mod :: WiringMap -> Module -> Module -upd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m - -upd_wired_in_uid :: WiringMap -> Unit -> Unit -upd_wired_in_uid wiredInMap u = case u of - HoleUnit -> HoleUnit - RealUnit (Definite uid) -> RealUnit (Definite (upd_wired_in wiredInMap uid)) - VirtUnit indef_uid -> - VirtUnit $ mkInstantiatedUnit - (instUnitInstanceOf indef_uid) - (map (\(x,y) -> (x,upd_wired_in_mod wiredInMap y)) (instUnitInsts indef_uid)) - -upd_wired_in :: WiringMap -> UnitId -> UnitId -upd_wired_in wiredInMap key - | Just key' <- Map.lookup key wiredInMap = key' - | otherwise = key - -updateVisibilityMap :: WiringMap -> VisibilityMap -> VisibilityMap -updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap) - where f vm (from, to) = case Map.lookup (RealUnit (Definite from)) vis_map of - Nothing -> vm - Just r -> Map.insert (RealUnit (Definite to)) r - (Map.delete (RealUnit (Definite from)) vm) + --ROMES:TODO + --updateWiredInDependencies pkgs = map (upd_deps . upd_pkg) pkgs + -- where upd_pkg pkg + -- | Just wiredInUnitId <- Map.lookup (unitId pkg) wiredInMap + -- = pkg { unitId = wiredInUnitId + -- , unitInstanceOf = wiredInUnitId + -- -- every non instantiated unit is an instance of + -- -- itself (required by Backpack...) + -- -- + -- -- See Note [About units] in GHC.Unit + -- } + -- | otherwise + -- = pkg + -- upd_deps pkg = pkg { + -- unitDepends = map (upd_wired_in wiredInMap) (unitDepends pkg), + -- unitExposedModules + -- = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v)) + -- (unitExposedModules pkg) + -- } + + + -- ROMES:TODO return (updateWiredInDependencies pkgs, wiredInMap) + return (pkgs, wiredInMap) + +-- We no longer have visibility issues since we remove the indirection? +-- This function was updating the wired-in names in the visibility map to the actual wired-in names, no longer needed +-- updateVisibilityMap :: WiringMap -> VisibilityMap -> VisibilityMap +-- updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap) +-- where f vm (from, to) = case Map.lookup (RealUnit (Definite from)) vis_map of +-- Nothing -> vm +-- Just r -> Map.insert (RealUnit (Definite to)) r +-- (Map.delete (RealUnit (Definite from)) vm) -- ---------------------------------------------------------------------------- @@ -1601,7 +1566,7 @@ mkUnitState logger cfg = do -- -hide-package). This needs to know about the unusable packages, since if a -- user tries to enable an unusable package, we should let them know. -- - vis_map2 <- mayThrowUnitErr + vis_map <- mayThrowUnitErr $ foldM (applyPackageFlag prec_map prelim_pkg_db emptyUniqSet unusable (unitConfigHideAll cfg) pkgs1) vis_map1 other_flags @@ -1611,14 +1576,11 @@ mkUnitState logger cfg = do -- it modifies the unit ids of wired in packages, but when we process -- package arguments we need to key against the old versions. -- - (pkgs2, wired_map) <- findWiredInUnits logger prec_map pkgs1 vis_map2 + (pkgs2, wired_map) <- findWiredInUnits logger prec_map pkgs1 vis_map let pkg_db = mkUnitInfoMap pkgs2 - -- Update the visibility map, so we treat wired packages as visible. - let vis_map = updateVisibilityMap wired_map vis_map2 - - let hide_plugin_pkgs = unitConfigHideAllPlugins cfg + hide_plugin_pkgs = unitConfigHideAllPlugins cfg plugin_vis_map <- case unitConfigFlagsPlugins cfg of -- common case; try to share the old vis_map @@ -1629,22 +1591,19 @@ mkUnitState logger cfg = do -- Use the vis_map PRIOR to wired in, -- because otherwise applyPackageFlag -- won't work. - | otherwise = vis_map2 - plugin_vis_map2 + | otherwise = vis_map + plugin_vis_map <- mayThrowUnitErr $ foldM (applyPackageFlag prec_map prelim_pkg_db emptyUniqSet unusable hide_plugin_pkgs pkgs1) plugin_vis_map1 (reverse (unitConfigFlagsPlugins cfg)) - -- Updating based on wired in packages is mostly - -- good hygiene, because it won't matter: no wired in - -- package has a compiler plugin. -- TODO: If a wired in package had a compiler plugin, -- and you tried to pick different wired in packages -- with the plugin flags and the normal flags... what -- would happen? I don't know! But this doesn't seem -- likely to actually happen. - return (updateVisibilityMap wired_map plugin_vis_map2) + return plugin_vis_map let pkgname_map = listToUFM [ (unitPackageName p, unitInstanceOf p) | p <- pkgs2 @@ -1696,13 +1655,11 @@ mkUnitState logger cfg = do , moduleNameProvidersMap = mod_map , pluginModuleNameProvidersMap = mkModuleNameProvidersMap logger cfg pkg_db emptyUniqSet plugin_vis_map , packageNameMap = pkgname_map - , wireMap = wired_map - , unwireMap = Map.fromList [ (v,k) | (k,v) <- Map.toList wired_map ] , requirementContext = req_ctx , allowVirtualUnits = unitConfigAllowVirtual cfg } - writeIORef workingThisOut (unwireMap state) + writeIORef workingThisOut wired_map return (state, raw_dbs) selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool @@ -1717,14 +1674,6 @@ selectHomeUnits home_units flags = foldl' go Set.empty flags -- MP: This does not yet support thinning/renaming go cur _ = cur - --- | Given a wired-in 'Unit', "unwire" it into the 'Unit' --- that it was recorded as in the package database. -unwireUnit :: UnitState -> Unit -> Unit -unwireUnit state uid@(RealUnit (Definite def_uid)) = - maybe uid (RealUnit . Definite) (Map.lookup def_uid (unwireMap state)) -unwireUnit _ uid = uid - -- ----------------------------------------------------------------------------- -- | Makes the mapping from ModuleName to package info ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Unit & Module types @@ -37,6 +38,7 @@ module GHC.Unit.Types , DefUnitId , Instantiations , GenInstantiations + , WiredInPackageName (..) , mkInstantiatedUnit , mkInstantiatedUnitHash , mkVirtUnit @@ -120,8 +122,8 @@ import {-# SOURCE #-} Language.Haskell.Syntax.ImpExp (IsBootInterface(..)) -- Ref for an "unwireMap" which maps wired-in ids to actual units, created by -- identifying wired-in packages in the list of package-id flags -workingThisOut :: IORef (Map UnitId UnitId) -workingThisOut = unsafePerformIO (newIORef (Map.singleton (UnitId $ fsLit "ouch-version") (UnitId $ fsLit "ouch"))) +workingThisOut :: IORef (Map WiredInPackageName UnitId) +workingThisOut = unsafePerformIO (newIORef (Map.singleton (WiredInPackageName $ fsLit "ouch-version") (UnitId $ fsLit "ouch"))) {-# NOINLINE workingThisOut #-} --------------------------------------------------------------------- @@ -557,6 +559,11 @@ unitIdString = unpackFS . unitIdFS stringToUnitId :: String -> UnitId stringToUnitId = UnitId . mkFastString +newtype WiredInPackageName = WiredInPackageName + { wiredInPackageNameFS :: FastString } + deriving (Data) + deriving (Binary, Eq, Ord, Uniquable, Outputable) via UnitId + --------------------------------------------------------------------- -- UTILS --------------------------------------------------------------------- @@ -601,7 +608,7 @@ Make sure you change 'GHC.Unit.State.findWiredInUnits' if you add an entry here. -} bignumUnitName, primUnitName, baseUnitName, rtsUnitName, - thUnitName, mainUnitName, thisGhcUnitName, interactiveUnitName :: FastString + thUnitName, mainUnitName, thisGhcUnitName, interactiveUnitName :: WiredInPackageName bignumUnitId, primUnitId, baseUnitId, rtsUnitId, thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId @@ -609,20 +616,20 @@ bignumUnitId, primUnitId, baseUnitId, rtsUnitId, bignumUnit, primUnit, baseUnit, rtsUnit, thUnit, mainUnit, thisGhcUnit, interactiveUnit :: Unit -primUnitName = fsLit "ghc-prim" -bignumUnitName = fsLit "ghc-bignum" -baseUnitName = fsLit "base" -rtsUnitName = fsLit "rts" -thisGhcUnitName = fsLit "ghc" -interactiveUnitName = fsLit "interactive" -thUnitName = fsLit "template-haskell" - -primUnitId = UnitId primUnitName -bignumUnitId = UnitId bignumUnitName -baseUnitId = UnitId baseUnitName -rtsUnitId = UnitId rtsUnitName -thisGhcUnitId = UnitId thisGhcUnitName -interactiveUnitId = UnitId interactiveUnitName +primUnitName = WiredInPackageName $ fsLit "ghc-prim" +bignumUnitName = WiredInPackageName $ fsLit "ghc-bignum" +baseUnitName = WiredInPackageName $ fsLit "base" +rtsUnitName = WiredInPackageName $ fsLit "rts" +thisGhcUnitName = WiredInPackageName $ fsLit "ghc" +interactiveUnitName = WiredInPackageName $ fsLit "interactive" +thUnitName = WiredInPackageName $ fsLit "template-haskell" + +primUnitId = mkWiredInUnitId primUnitName +bignumUnitId = mkWiredInUnitId bignumUnitName +baseUnitId = mkWiredInUnitId baseUnitName +rtsUnitId = mkWiredInUnitId rtsUnitName +thisGhcUnitId = mkWiredInUnitId thisGhcUnitName +interactiveUnitId = UnitId $ wiredInPackageNameFS interactiveUnitName thUnitId = mkWiredInUnitId thUnitName {-# INLINE bignumUnitId #-} {-# INLINE baseUnitId #-} @@ -641,21 +648,21 @@ interactiveUnit = RealUnit (Definite interactiveUnitId) -- | This is the package Id for the current program. It is the default -- package Id if you don't specify a package name. We don't add this prefix -- to symbol names, since there can be only one main package per program. -mainUnitName = fsLit "main" -mainUnitId = UnitId mainUnitName +mainUnitName = WiredInPackageName $ fsLit "main" +mainUnitId = UnitId $ wiredInPackageNameFS mainUnitName mainUnit = RealUnit (Definite mainUnitId) -- Make the actual unit id the result of looking up the wired-in unit package name in the wire map -mkWiredInUnitId :: FastString -> UnitId -mkWiredInUnitId x = case Map.lookup (UnitId x) $ unsafePerformIO (readIORef workingThisOut) of - Nothing -> pprTrace "Romes:Couldn't find UnitId" (ppr (UnitId x,unsafePerformIO (readIORef workingThisOut))) (UnitId $ fsLit "rts") -- this is a fallback, in which situations do we need a fallback? perhaps when booting the compiler with the rts? +mkWiredInUnitId :: WiredInPackageName -> UnitId +mkWiredInUnitId x = case Map.lookup x $ unsafePerformIO (readIORef workingThisOut) of + Nothing -> pprTrace "Romes:Couldn't find UnitId" (ppr (x,unsafePerformIO (readIORef workingThisOut))) (UnitId $ fsLit "rts") -- this is a fallback, in which situations do we need a fallback? perhaps when booting the compiler with the rts? Just y -> pprTrace "Romes:Found in wire map" (ppr x <+> text "->" <> ppr y) y isInteractiveModule :: Module -> Bool isInteractiveModule mod = moduleUnit mod == interactiveUnit -wiredInUnitNames :: [FastString] +wiredInUnitNames :: [WiredInPackageName] wiredInUnitNames = [ primUnitName , bignumUnitName ===================================== del-this-unit-id.sh ===================================== @@ -0,0 +1 @@ +sed -i '' 's/ghc-options: -this-unit-id.*//i' compiler/ghc.cabal.in libraries/base/base.cabal libraries/ghc-bignum/ghc-bignum.cabal libraries/ghc-prim/ghc-prim.cabal rts/rts.cabal.in libraries/template-haskell/template-haskell.cabal.in View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22036aa2f01cb01a24cb203744ad4233dcd0b947 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22036aa2f01cb01a24cb203744ad4233dcd0b947 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 17:35:02 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 06 Mar 2023 12:35:02 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T23051 Message-ID: <640624469020d_3ab52b62f874f894828f@gitlab.mail> Simon Peyton Jones pushed new branch wip/T23051 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23051 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 18:04:34 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Mon, 06 Mar 2023 13:04:34 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T22997 Message-ID: <64062b32e7eb0_3ab52b638d760c954046@gitlab.mail> Sebastian Graf pushed new branch wip/T22997 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22997 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 18:27:33 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Mon, 06 Mar 2023 13:27:33 -0500 Subject: [Git][ghc/ghc][wip/T20749] 131 commits: Bump transformers submodule to 0.6.0.6 Message-ID: <6406309523cfe_3ab52b63f9c3fc9686e2@gitlab.mail> Sebastian Graf pushed to branch wip/T20749 at Glasgow Haskell Compiler / GHC Commits: 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 77ef96d9 by Sebastian Graf at 2023-03-06T19:23:58+01:00 Make DataCon workers strict in strict fields (#20749) This patch tweaks `exprIsConApp_maybe`, `exprIsHNF` and friends, and Demand Analysis so that they exploit and maintain strictness of DataCon workers. See `Note [Strict fields in Core]` for details. Very little needed to change, and it puts field seq insertion done by Tag Inference into a new perspective: That of *implementing* strict field semantics. Before Tag Inference, DataCon workers are strict. Afterwards they are effectively lazy and field seqs happen around use sites. History has shown that there is no other way to guarantee taggedness and thus the STG Strict Field Invariant. Knock-on changes: * `exprIsHNF` previously used `exprOkForSpeculation` on unlifted arguments instead of recursing into `exprIsHNF`. That regressed the termination analysis in CPR analysis (which simply calls out to `exprIsHNF`), so I made it call `exprOkForSpeculation`, too. * There's a small regression in Demand Analysis, visible in the changed test output of T16859: Previously, a field seq on a variable would give that variable a "used exactly once" demand, now it's "used at least once", because `dmdTransformDataConSig` accounts for future uses of the field that actually all go through the case binder (and hence won't re-enter the potential thunk). The difference should hardly be observable. * The Simplifier's fast path for data constructors only applies to lazy data constructors now. I observed regressions involving Data.Binary.Put's `Pair` data type. * Unfortunately, T21392 does no longer reproduce after this patch, so I marked it as "not broken" in order to track whether we regress again in the future. Fixes #20749, the satisfying conclusion of an annoying saga (cf. the ideas in #21497 and #22475). - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitlab/test-metrics.sh - CODEOWNERS - cabal.project-reinstall - compile_flags.txt - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToLlvm/Mangler.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a759195932880101fb73350156212b3449d536b...77ef96d9d50fd8512e9bd4324ea5446f1eac1159 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a759195932880101fb73350156212b3449d536b...77ef96d9d50fd8512e9bd4324ea5446f1eac1159 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 19:36:44 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 06 Mar 2023 14:36:44 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Add regression test for #22328 Message-ID: <640640ccd4739_3ab52b652f66a098586f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 4b4cb2a5 by Gabriella Gonzalez at 2023-03-06T14:36:35-05:00 Enable response files for linker if supported - - - - - 1cd5ed42 by Gabriella Gonzalez at 2023-03-06T14:36:35-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 09b37aad by Gabriella Gonzalez at 2023-03-06T14:36:35-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - ca298487 by sheaf at 2023-03-06T14:36:35-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - be2c487f by Gabriella Gonzalez at 2023-03-06T14:36:35-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 7e24ba7f by Gabriella Gonzalez at 2023-03-06T14:36:35-05:00 Quote variables … as suggested by @bgamari - - - - - af6e9f69 by Gabriella Gonzalez at 2023-03-06T14:36:35-05:00 Fix configure failure on alpine linux - - - - - 0b470837 by Gabriella Gonzalez at 2023-03-06T14:36:35-05:00 Small fixes to configure script - - - - - 4ab7c947 by Andrei Borzenkov at 2023-03-06T14:36:39-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - 30 changed files: - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - + m4/fp_ld_supports_response_files.m4 - testsuite/tests/deriving/should_fail/T10598_fail4.stderr - testsuite/tests/deriving/should_fail/T10598_fail5.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail3.stderr - testsuite/tests/ghci/prog019/prog019.stderr - testsuite/tests/ghci/scripts/T1914.stderr - testsuite/tests/ghci/scripts/T6018ghcirnfail.stderr - testsuite/tests/ghci/scripts/T6106.stderr - testsuite/tests/indexed-types/should_fail/T5515.stderr - testsuite/tests/parser/should_fail/T3811c.stderr - + testsuite/tests/patsyn/should_compile/T22328.hs - testsuite/tests/patsyn/should_compile/all.T - testsuite/tests/polykinds/T9574.stderr - testsuite/tests/rename/should_compile/T15798a.stderr - testsuite/tests/rename/should_compile/T15798b.stderr - testsuite/tests/rename/should_compile/T15798c.stderr - testsuite/tests/rename/should_fail/ExplicitForAllRules2.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87aee8fb461a58510e38d7897a7d78e54ab6fa64...4ab7c947efc1cb15631b397b361f5eca95d6c7d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87aee8fb461a58510e38d7897a7d78e54ab6fa64...4ab7c947efc1cb15631b397b361f5eca95d6c7d7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 22:07:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 06 Mar 2023 17:07:07 -0500 Subject: [Git][ghc/ghc][master] 8 commits: Enable response files for linker if supported Message-ID: <6406640b7e0ff_3ab52b678ebcac1006720@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - 10 changed files: - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - + m4/fp_ld_supports_response_files.m4 Changes: ===================================== compiler/GHC/Settings.hs ===================================== @@ -19,6 +19,7 @@ module GHC.Settings , sGlobalPackageDatabasePath , sLdSupportsCompactUnwind , sLdSupportsFilelist + , sLdSupportsResponseFiles , sLdIsGnuLd , sGccSupportsNoPie , sUseInplaceMinGW @@ -87,6 +88,7 @@ data Settings = Settings data ToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind :: Bool , toolSettings_ldSupportsFilelist :: Bool + , toolSettings_ldSupportsResponseFiles :: Bool , toolSettings_ldIsGnuLd :: Bool , toolSettings_ccSupportsNoPie :: Bool , toolSettings_useInplaceMinGW :: Bool @@ -189,6 +191,8 @@ sLdSupportsCompactUnwind :: Settings -> Bool sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings sLdSupportsFilelist :: Settings -> Bool sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings +sLdSupportsResponseFiles :: Settings -> Bool +sLdSupportsResponseFiles = toolSettings_ldSupportsResponseFiles . sToolSettings sLdIsGnuLd :: Settings -> Bool sLdIsGnuLd = toolSettings_ldIsGnuLd . sToolSettings sGccSupportsNoPie :: Settings -> Bool ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -95,6 +95,7 @@ initSettings top_dir = do cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" + ldSupportsResponseFiles <- getBooleanSetting "ld supports response files" ldIsGnuLd <- getBooleanSetting "ld is GNU ld" arSupportsDashL <- getBooleanSetting "ar supports -L" @@ -163,6 +164,7 @@ initSettings top_dir = do , sToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind , toolSettings_ldSupportsFilelist = ldSupportsFilelist + , toolSettings_ldSupportsResponseFiles = ldSupportsResponseFiles , toolSettings_ldIsGnuLd = ldIsGnuLd , toolSettings_ccSupportsNoPie = gccSupportsNoPie , toolSettings_useInplaceMinGW = useInplaceMinGW ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Utils.TmpFs -import GHC.Utils.Constants (isWindowsHost) import GHC.Utils.Panic import Data.List (tails, isPrefixOf) @@ -350,9 +349,7 @@ runMergeObjects logger tmpfs dflags args = , "does not support object merging." ] optl_args = map Option (getOpts dflags opt_lm) args2 = args0 ++ args ++ optl_args - -- N.B. Darwin's ld64 doesn't support response files. Consequently we only - -- use them on Windows where they are truly necessary. - if isWindowsHost + if toolSettings_ldSupportsResponseFiles (toolSettings dflags) then do mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags id "Merge objects" p args2 mb_env ===================================== configure.ac ===================================== @@ -663,6 +663,8 @@ FP_LD_NO_FIXUP_CHAINS([build], [CONF_GCC_LINKER_OPTS_STAGE0]) FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE2]) +FP_LD_SUPPORTS_RESPONSE_FILES + GHC_LLVM_TARGET_SET_VAR # we intend to pass trough --targets to llvm as is. LLVMTarget_CPP=` echo "$LlvmTarget"` ===================================== distrib/configure.ac.in ===================================== @@ -180,6 +180,8 @@ FP_LD_NO_FIXUP_CHAINS([build], [CONF_GCC_LINKER_OPTS_STAGE0]) FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE2]) +FP_LD_SUPPORTS_RESPONSE_FILES + AC_SUBST(CONF_CC_OPTS_STAGE0) AC_SUBST(CONF_CC_OPTS_STAGE1) AC_SUBST(CONF_CC_OPTS_STAGE2) ===================================== hadrian/bindist/Makefile ===================================== @@ -92,6 +92,7 @@ lib/settings : config.mk @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ + @echo ',("ld supports response files", "$(LdSupportsResponseFiles)")' >> $@ @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ @echo ',("Merge objects flags", "$(SettingsMergeObjectsFlags)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -236,6 +236,7 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL GccExtraViaCOpts = @GccExtraViaCOpts@ LdHasFilelist = @LdHasFilelist@ +LdSupportsResponseFiles = @LdSupportsResponseFiles@ LdHasBuildId = @LdHasBuildId@ LdHasFilelist = @LdHasFilelist@ LdIsGNULd = @LdIsGNULd@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -140,6 +140,7 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ gcc-extra-via-c-opts = @GccExtraViaCOpts@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ +ld-supports-response-files = @LdSupportsResponseFiles@ ld-is-gnu-ld = @LdIsGNULd@ ar-args = @ArArgs@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -427,6 +427,7 @@ generateSettings = do , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags) , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") + , ("ld supports response files", expr $ lookupSystemConfig "ld-supports-response-files") , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") , ("Merge objects command", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsCommand) , ("Merge objects flags", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsFlags) ===================================== m4/fp_ld_supports_response_files.m4 ===================================== @@ -0,0 +1,19 @@ +# FP_LD_SUPPORTS_RESPONSE_FILES +# -------------------- +# See if whether we are using a version of ld which supports response files. +AC_DEFUN([FP_LD_SUPPORTS_RESPONSE_FILES], [ + AC_MSG_CHECKING([whether $LD supports response files]) + echo 'int main(void) {return 0;}' > conftest.c + "$CC" -c -o conftest.o conftest.c > /dev/null 2>&1 + printf '%q\n' -o conftest conftest.o > args.txt + if "$LD" -shared @args.txt > /dev/null 2>&1 || "$LD" -dylib @args.txt > /dev/null 2>&1 + then + LdSupportsResponseFiles=YES + AC_MSG_RESULT([yes]) + else + LdSupportsResponseFiles=NO + AC_MSG_RESULT([no]) + fi + rm -f conftest.c conftest args.txt + AC_SUBST(LdSupportsResponseFiles) +]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/232cfc241c14ba6a49d9552a90a94857255e455d...c56a3ae681becc7736e5a0e3d0461b8872a02707 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/232cfc241c14ba6a49d9552a90a94857255e455d...c56a3ae681becc7736e5a0e3d0461b8872a02707 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 22:07:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 06 Mar 2023 17:07:58 -0500 Subject: [Git][ghc/ghc][master] Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) Message-ID: <6406643e49144_3ab52b67bd68401012339@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - 30 changed files: - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/deriving/should_fail/T10598_fail4.stderr - testsuite/tests/deriving/should_fail/T10598_fail5.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail3.stderr - testsuite/tests/ghci/prog019/prog019.stderr - testsuite/tests/ghci/scripts/T1914.stderr - testsuite/tests/ghci/scripts/T6018ghcirnfail.stderr - testsuite/tests/ghci/scripts/T6106.stderr - testsuite/tests/indexed-types/should_fail/T5515.stderr - testsuite/tests/parser/should_fail/T3811c.stderr - testsuite/tests/polykinds/T9574.stderr - testsuite/tests/rename/should_compile/T15798a.stderr - testsuite/tests/rename/should_compile/T15798b.stderr - testsuite/tests/rename/should_compile/T15798c.stderr - testsuite/tests/rename/should_fail/ExplicitForAllRules2.stderr - + testsuite/tests/rename/should_fail/RnStupidThetaInGadt.hs - + testsuite/tests/rename/should_fail/RnStupidThetaInGadt.stderr - + testsuite/tests/rename/should_fail/RnUnexpectedStandaloneDeriving.hs - + testsuite/tests/rename/should_fail/RnUnexpectedStandaloneDeriving.stderr - testsuite/tests/rename/should_fail/T12146.stderr - testsuite/tests/rename/should_fail/T15659.stderr - testsuite/tests/rename/should_fail/T18021.stderr - testsuite/tests/rename/should_fail/T18240a.stderr - testsuite/tests/rename/should_fail/T4042.stderr - testsuite/tests/rename/should_fail/T6018rnfail.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/roles/should_fail/Roles8.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cad5c5760f6fe06057eb7ad9927b9c1e83417c1e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cad5c5760f6fe06057eb7ad9927b9c1e83417c1e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 6 23:26:14 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Mon, 06 Mar 2023 18:26:14 -0500 Subject: [Git][ghc/ghc][wip/T21909] 12 commits: Fix typo in docs referring to threadLabel Message-ID: <640676966c8ce_3ab52b6914ff781022196@gitlab.mail> sheaf pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - 30 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Types/Error/Codes.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/9.6.1-notes.rst - docs/users_guide/expected-undocumented-flags.txt - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - + m4/fp_ld_supports_response_files.m4 - testsuite/tests/deriving/should_fail/T10598_fail4.stderr - testsuite/tests/deriving/should_fail/T10598_fail5.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail3.stderr - testsuite/tests/ghci/prog019/prog019.stderr - testsuite/tests/ghci/scripts/T1914.stderr - testsuite/tests/ghci/scripts/T6018ghcirnfail.stderr - testsuite/tests/ghci/scripts/T6106.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f5c3ae02d74d94d3183f288fb70a076babf338b2...c6432eacdac8e8fd135e52b2fb51bcb43b6913c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f5c3ae02d74d94d3183f288fb70a076babf338b2...c6432eacdac8e8fd135e52b2fb51bcb43b6913c3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 01:40:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 06 Mar 2023 20:40:22 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Enable response files for linker if supported Message-ID: <64069606ccbe4_3ab52b6b8caaa810280d7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - dc3c74c8 by Bodigrim at 2023-03-06T20:40:18-05:00 Documentation: describe laziness of several function from Data.List - - - - - 30 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Types/Error/Codes.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/expected-undocumented-flags.txt - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs - + m4/fp_ld_supports_response_files.m4 - testsuite/tests/deriving/should_fail/T10598_fail4.stderr - testsuite/tests/deriving/should_fail/T10598_fail5.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail3.stderr - testsuite/tests/ghci/prog019/prog019.stderr - testsuite/tests/ghci/scripts/T1914.stderr - testsuite/tests/ghci/scripts/T6018ghcirnfail.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4ab7c947efc1cb15631b397b361f5eca95d6c7d7...dc3c74c8d090c8b49a467516cf918e9c9f560380 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4ab7c947efc1cb15631b397b361f5eca95d6c7d7...dc3c74c8d090c8b49a467516cf918e9c9f560380 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 03:50:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 06 Mar 2023 22:50:48 -0500 Subject: [Git][ghc/ghc][master] Constraint simplification loop now depends on `ExpansionFuel` Message-ID: <6406b4985b7e9_3ab52b6da0665410414d0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - 11 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - docs/users_guide/expected-undocumented-flags.txt - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Class.hs ===================================== @@ -17,8 +17,8 @@ module GHC.Core.Class ( mkClass, mkAbstractClass, classTyVars, classArity, classKey, className, classATs, classATItems, classTyCon, classMethods, classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta, - classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, classHasFds, - isAbstractClass, + classHasSCs, classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, + classHasFds, isAbstractClass, ) where import GHC.Prelude @@ -295,6 +295,9 @@ classSCTheta (Class { classBody = ConcreteClass { cls_sc_theta = theta_stuff }}) = theta_stuff classSCTheta _ = [] +classHasSCs :: Class -> Bool +classHasSCs cls = not (null (classSCTheta cls)) + classTvsFds :: Class -> ([TyVar], [FunDep TyVar]) classTvsFds c = (classTyVars c, classFunDeps c) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -517,7 +517,15 @@ data DynFlags = DynFlags { reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver -- Typically only 1 is needed - + givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens + -- Should be < solverIterations + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] homeUnitId_ :: UnitId, -- ^ Target home unit-id homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations @@ -1148,6 +1156,9 @@ defaultDynFlags mySettings = mainFunIs = Nothing, reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, homeUnitId_ = mainUnitId, homeUnitInstanceOf_ = Nothing, @@ -2733,6 +2744,12 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n })) , make_ord_flag defFlag "fconstraint-solver-iterations" (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n })) + , make_ord_flag defFlag "fgivens-expansion-fuel" + (intSuffix (\n d -> d { givensFuel = n })) + , make_ord_flag defFlag "fwanteds-expansion-fuel" + (intSuffix (\n d -> d { wantedsFuel = n })) + , make_ord_flag defFlag "fqcs-expansion-fuel" + (intSuffix (\n d -> d { qcsFuel = n })) , (Deprecated, defFlag "fcontext-stack" (intSuffixM (\n d -> do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead" ===================================== compiler/GHC/Settings/Constants.hs ===================================== @@ -30,6 +30,27 @@ mAX_REDUCTION_DEPTH = 200 mAX_SOLVER_ITERATIONS :: Int mAX_SOLVER_ITERATIONS = 4 +-- | In case of loopy quantified costraints constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_QC_FUEL :: Int +mAX_QC_FUEL = 3 + +-- | In case of loopy wanted constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_GIVENS_FUEL +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_WANTEDS_FUEL :: Int +mAX_WANTEDS_FUEL = 1 + +-- | In case of loopy given constraints, +-- how many times should we allow superclass expansions +-- Should be less than max_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_GIVENS_FUEL :: Int +mAX_GIVENS_FUEL = 3 + wORD64_SIZE :: Int wORD64_SIZE = 8 ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2338,6 +2338,10 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set + ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given + , text "new_given" <+> ppr new_given + , text "pending_wanted" <+> ppr pending_wanted + , text "new_wanted" <+> ppr new_wanted ]) ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } -- (not (null pending_given)): see Note [Superclass iteration] @@ -2366,6 +2370,73 @@ superclasses. In that case we check whether the new Wanteds actually led to any new unifications, and iterate the implications only if so. -} +{- Note [Expanding Recursive Superclasses and ExpansionFuel] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the class declaration (T21909) + + class C [a] => C a where + foo :: a -> Int + +and suppose during type inference we obtain an implication constraint: + + forall a. C a => C [[a]] + +To solve this implication constraint, we first expand one layer of the superclass +of Given constraints, but not for Wanted constraints. +(See Note [Eagerly expand given superclasses] and Note [Why adding superclasses can help] +in GHC.Tc.Solver.Canonical.) We thus get: + + [G] g1 :: C a + [G] g2 :: C [a] -- new superclass layer from g1 + [W] w1 :: C [[a]] + +Now, we cannot solve `w1` directly from `g1` or `g2` as we may not have +any instances for C. So we expand a layer of superclasses of each Wanteds and Givens +that we haven't expanded yet. +This is done in `maybe_simplify_again`. And we get: + + [G] g1 :: C a + [G] g2 :: C [a] + [G] g3 :: C [[a]] -- new superclass layer from g2, can solve w1 + [W] w1 :: C [[a]] + [W] w2 :: C [[[a]]] -- new superclass layer from w1, not solvable + +Now, although we can solve `w1` using `g3` (obtained from expanding `g2`), +we have a new wanted constraint `w2` (obtained from expanding `w1`) that cannot be solved. +We thus make another go at solving in `maybe_simplify_again` by expanding more +layers of superclasses. This looping is futile as Givens will never be able to catch up with Wanteds. + +Side Note: In principle we don't actually need to /solve/ `w2`, as it is a superclass of `w1` +but we only expand it to expose any functional dependencies (see Note [The superclass story]) +But `w2` is a wanted constraint, so we will try to solve it like any other, +even though ultimately we will discard its evidence. + +Solution: Simply bound the maximum number of layers of expansion for +Givens and Wanteds, with ExpansionFuel. Give the Givens more fuel +(say 3 layers) than the Wanteds (say 1 layer). Now the Givens will +win. The Wanteds don't need much fuel: we are only expanding at all +to expose functional dependencies, and wantedFuel=1 means we will +expand a full recursive layer. If the superclass hierarchy is +non-recursive (the normal case) one layer is therefore full expansion. + +The default value for wantedFuel = Constants.max_WANTEDS_FUEL = 1. +The default value for givenFuel = Constants.max_GIVENS_FUEL = 3. +Both are configurable via the `-fgivens-fuel` and `-fwanteds-fuel` +compiler flags. + +There are two preconditions for the default fuel values: + (1) default givenFuel >= default wantedsFuel + (2) default givenFuel < solverIterations + +Precondition (1) ensures that we expand givens at least as many times as we expand wanted constraints +preferably givenFuel > wantedsFuel to avoid issues like T21909 while +the precondition (2) ensures that we do not reach the solver iteration limit and fail with a +more meaningful error message + +This also applies for quantified constraints; see `-fqcs-fuel` compiler flag and `QCI.qci_pend_sc` field. +-} + + solveNestedImplications :: Bag Implication -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -59,7 +59,7 @@ import Control.Monad import Data.Maybe ( isJust, isNothing ) import Data.List ( zip4 ) import GHC.Types.Basic - +import GHC.Driver.Session ( givensFuel, wantedsFuel, qcsFuel ) import qualified Data.Semigroup as S import Data.Bifunctor ( bimap ) @@ -154,9 +154,13 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys doNotExpand } + -- doNotExpand: We have already expanded superclasses for /this/ dict + -- so set the fuel to doNotExpand to avoid repeating expansion | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -168,7 +172,7 @@ canClassNC ev cls tys -- and Note [Solving CallStack constraints] in GHC.Tc.Solver.Types = do { -- First we emit a new constraint that will capture the -- given CallStack. - ; let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) + let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) -- We change the origin to IPOccOrigin so -- this rule does not fire again. -- See Note [Overview of implicit CallStacks] @@ -182,14 +186,20 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys doNotExpand + -- doNotExpand: No superclasses for class CallStack + -- See invariants in CDictCan.cc_pend_sc } | otherwise - = canClass ev cls tys (has_scs cls) + = do { dflags <- getDynFlags + ; let fuel | classHasSCs cls = wantedsFuel dflags + | otherwise = doNotExpand + -- See Invariants in `CCDictCan.cc_pend_sc` + ; canClass ev cls tys fuel + } where - has_scs cls = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -206,7 +216,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -307,10 +317,11 @@ So here's the plan: 4. Go round to (2) again. This loop (2,3,4) is implemented in GHC.Tc.Solver.simpl_loop. -The cc_pend_sc flag in a CDictCan records whether the superclasses of +The cc_pend_sc field in a CDictCan records whether the superclasses of this constraint have been expanded. Specifically, in Step 3 we only -expand superclasses for constraints with cc_pend_sc set to true (i.e. -isPendingScDict holds). +expand superclasses for constraints with cc_pend_sc > 0 +(i.e. isPendingScDict holds). +See Note [Expanding Recursive Superclasses and ExpansionFuel] Why do we do this? Two reasons: @@ -337,7 +348,8 @@ our strategy. Consider f :: C a => a -> Bool f x = x==x Then canClassNC gets the [G] d1: C a constraint, and eager emits superclasses -G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its sc_pend flag set.) +G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its cc_pend_sc has pending +expansion fuel.) When processing d3 we find a match with d1 in the inert set, and we always keep the inert item (d1) if possible: see Note [Replacement vs keeping] in GHC.Tc.Solver.Interact. So d3 dies a quick, happy death. @@ -484,7 +496,6 @@ the sc_theta_ids at all. So our final construction is makeSuperClasses :: [Ct] -> TcS [Ct] -- Returns strict superclasses, transitively, see Note [The superclass story] --- See Note [The superclass story] -- The loop-breaking here follows Note [Expanding superclasses] in GHC.Tc.Utils.TcType -- Specifically, for an incoming (C t) constraint, we return all of (C t)'s -- superclasses, up to /and including/ the first repetition of C @@ -493,39 +504,45 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- class C [a] => D a -- makeSuperClasses (C x) will return (D x, C [x]) -- --- NB: the incoming constraints have had their cc_pend_sc flag already --- flipped to False, by isPendingScDict, so we are /obliged/ to at --- least produce the immediate superclasses +-- NB: the incoming constraint's superclass will consume a unit of fuel +-- Preconditions on `cts`: 1. They are either `CDictCan` or `CQuantCan` +-- 2. Their fuel (stored in cc_pend_sc or qci_pend_sc) is > 0 makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys - go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev [] [] cls tys + go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +-- Precondition: fuel > 0 +-- Postcondition: fuel for recursive superclass ct is one unit less than cls fuel +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses (consumeFuel fuel) (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +-- The caller of this function is supposed to perform fuel book keeping +-- Precondition: fuel >= 0 +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -543,7 +560,8 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; assertFuelPrecondition fuel + $ mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -604,7 +622,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -619,7 +637,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -634,46 +652,53 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +-- Precondition: fuel >= 0 +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = assertFuelPrecondition fuel $ + mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +-- Precondition: fuel >= 0 +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) - ; return [this_ct] } -- cc_pend_sc of this_ct = True + ; assertFuelPrecondition fuel $ return [mk_this_ct fuel] } + -- cc_pend_sc of returning ct = fuel | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys - ; return (this_ct : sc_cts) } - -- cc_pend_sc of this_ct = False + ; sc_cts <- assertFuelPrecondition fuel $ + mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys + ; return (mk_this_ct doNotExpand : sc_cts) } + -- doNotExpand: we have expanded this cls's superclasses, so + -- exhaust the associated constraint's fuel, + -- to avoid duplicate work where cls_nm = className cls loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm - - this_ct | null tvs, null theta - = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } - -- NB: If there is a loop, we cut off, so we have not - -- added the superclasses, hence cc_pend_sc = True - | otherwise - = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys - , qci_ev = ev - , qci_pend_sc = loop_found }) + mk_this_ct :: ExpansionFuel -> Ct + mk_this_ct fuel | null tvs, null theta + = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys + , cc_pend_sc = fuel } + -- NB: If there is a loop, we cut off, so we have not + -- added the superclasses, hence cc_pend_sc = fuel + | otherwise + = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys + , qci_ev = ev + , qci_pend_sc = fuel }) {- Note [Equality superclasses in quantified constraints] @@ -828,19 +853,28 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev tvs theta cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canForAll ev False } + ; canForAll ev doNotExpand } + -- doNotExpand: as we have already (eagerly) expanded superclasses for this class | otherwise - = canForAll ev (isJust cls_pred_tys_maybe) - + = do { dflags <- getDynFlags + ; let fuel | Just (cls, _) <- cls_pred_tys_maybe + , classHasSCs cls = qcsFuel dflags + -- See invariants (a) and (b) in QCI.qci_pend_sc + -- qcsFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + -- See Note [Quantified constraints] + | otherwise = doNotExpand + ; canForAll ev fuel } where cls_pred_tys_maybe = getClassPredTys_maybe pred -canForAll :: CtEvidence -> Bool -> TcS (StopOrContinue Ct) +canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) -- We have a constraint (forall as. blah => C tys) -canForAll ev pend_sc +canForAll ev fuel = do { -- First rewrite it to apply the current substitution let pred = ctEvPred ev ; (redn, rewriters) <- rewrite ev pred @@ -850,14 +884,14 @@ canForAll ev pend_sc -- (It takes a lot less code to rewrite before decomposing.) ; case classifyPredType (ctEvPred new_ev) of ForAllPred tvs theta pred - -> solveForAll new_ev tvs theta pred pend_sc + -> solveForAll new_ev tvs theta pred fuel _ -> pprPanic "canForAll" (ppr new_ev) } } -solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> Bool +solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel -> TcS (StopOrContinue Ct) solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) - tvs theta pred _pend_sc + tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] setLclEnv (ctLocEnv loc) $ -- This setLclEnv is important: the emitImplicationTcS uses that @@ -903,12 +937,12 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo _ -> pSizeType pred -- See Note [Solving a Given forall-constraint] -solveForAll ev@(CtGiven {}) tvs _theta pred pend_sc +solveForAll ev@(CtGiven {}) tvs _theta pred fuel = do { addInertForAll qci ; stopWith ev "Given forall-constraint" } where qci = QCI { qci_ev = ev, qci_tvs = tvs - , qci_pred = pred, qci_pend_sc = pend_sc } + , qci_pred = pred, qci_pend_sc = fuel } {- Note [Solving a Wanted forall-constraint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -513,10 +513,13 @@ getInertGivens ; return (filter isGivenCt all_cts) } getPendingGivenScs :: TcS [Ct] --- Find all inert Given dictionaries, or quantified constraints, --- whose cc_pend_sc flag is True --- and that belong to the current level --- Set their cc_pend_sc flag to False in the inert set, and return that Ct +-- Find all inert Given dictionaries, or quantified constraints, such that +-- 1. cc_pend_sc flag has fuel strictly > 0 +-- 2. belongs to the current level +-- For each such dictionary: +-- * Return it (with unmodified cc_pend_sc) in sc_pending +-- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand +-- to record that we have expanded superclasses for this dict getPendingGivenScs = do { lvl <- getTcLevel ; updRetInertCans (get_sc_pending lvl) } @@ -530,29 +533,33 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) sc_pending = sc_pend_insts ++ sc_pend_dicts sc_pend_dicts = foldDicts get_pending dicts [] - dicts' = foldr add dicts sc_pend_dicts + dicts' = foldr exhaustAndAdd dicts sc_pend_dicts (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts - | Just dict' <- pendingScDict_maybe dict + | isPendingScDict dict , belongs_to_this_level (ctEvidence dict) - = dict' : dicts + = dict : dicts | otherwise = dicts - add :: Ct -> DictMap Ct -> DictMap Ct - add ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts - = addDict dicts cls tys ct - add ct _ = pprPanic "getPendingScDicts" (ppr ct) + exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct + exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts + -- exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) + exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) get_pending_inst cts qci@(QCI { qci_ev = ev }) | Just qci' <- pendingScInst_maybe qci , belongs_to_this_level ev - = (CQuantCan qci' : cts, qci') + = (CQuantCan qci : cts, qci') + -- qci' have their fuel exhausted + -- we don't want to expand these constraints again + -- qci is expanded | otherwise = (cts, qci) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,6 +11,8 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, + ExpansionFuel, doNotExpand, consumeFuel, pendingFuel, + assertFuelPrecondition, assertFuelPreconditionStrict, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -138,8 +140,6 @@ import Data.Word ( Word8 ) import Data.List ( intersperse ) - - {- ************************************************************************ * * @@ -191,6 +191,37 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- Invariant: ExpansionFuel should always be >= 0 +-- see Note [Expanding Recursive Superclasses and ExpansionFuel] +type ExpansionFuel = Int + +-- | Do not expand superclasses any further +doNotExpand :: ExpansionFuel +doNotExpand = 0 + +-- | Consumes one unit of fuel. +-- Precondition: fuel > 0 +consumeFuel :: ExpansionFuel -> ExpansionFuel +consumeFuel fuel = assertFuelPreconditionStrict fuel $ fuel - 1 + +-- | Returns True if we have any fuel left for superclass expansion +pendingFuel :: ExpansionFuel -> Bool +pendingFuel n = n > 0 + +insufficientFuelError :: SDoc +insufficientFuelError = text "Superclass expansion fuel should be > 0" + +-- | asserts if fuel is non-negative +assertFuelPrecondition :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPrecondition #-} +assertFuelPrecondition fuel = assertPpr (fuel >= 0) insufficientFuelError + +-- | asserts if fuel is strictly greater than 0 +assertFuelPreconditionStrict :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPreconditionStrict #-} +assertFuelPreconditionStrict fuel = assertPpr (pendingFuel fuel) insufficientFuelError + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,11 +230,12 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those - -- superclasses as Givens + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver + -- Invariants: cc_pend_sc > 0 <=> + -- (a) cc_class has superclasses + -- (b) those superclasses are not yet explored } | CIrredCan { -- These stand for yet-unusable predicates @@ -273,8 +305,13 @@ data QCInst -- A much simplified version of ClsInst -- Always Given , qci_tvs :: [TcTyVar] -- The tvs , qci_pred :: TcPredType -- The ty - , qci_pend_sc :: Bool -- Same as cc_pend_sc flag in CDictCan - -- Invariant: True => qci_pred is a ClassPred + , qci_pend_sc :: ExpansionFuel + -- Invariants: qci_pend_sc > 0 => + -- (a) qci_pred is a ClassPred + -- (b) this class has superclass(es), and + -- (c) the superclass(es) are not explored yet + -- Same as cc_pend_sc flag in CDictCan + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver } instance Outputable QCInst where @@ -673,11 +710,11 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason - CQuantCan (QCI { qci_pend_sc = pend_sc }) - | pend_sc -> text "CQuantCan(psc)" + CQuantCan (QCI { qci_pend_sc = psc }) + | psc > 0 -> text "CQuantCan" <> parens (text "psc" <+> ppr psc) | otherwise -> text "CQuantCan" ----------------------------------- @@ -893,23 +930,24 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = f }) = pendingFuel f +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, --- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, +-- AND if so exhausts the fuel so that they are not expanded again +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = f }) + | pendingFuel f = Just (ct { cc_pend_sc = doNotExpand }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst -- Same as isPendingScDict, but for QCInsts -pendingScInst_maybe qci@(QCI { qci_pend_sc = True }) - = Just (qci { qci_pend_sc = False }) -pendingScInst_maybe _ = Nothing +pendingScInst_maybe qci@(QCI { qci_pend_sc = f }) + | pendingFuel f = Just (qci { qci_pend_sc = doNotExpand }) + | otherwise = Nothing superClassesMightHelp :: WantedConstraints -> Bool -- ^ True if taking superclasses of givens, or of wanteds (to perhaps @@ -928,11 +966,12 @@ superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics }) is_ip _ = False getPendingWantedScs :: Cts -> ([Ct], Cts) +-- in the return values [Ct] has original fuel while Cts has fuel exhausted getPendingWantedScs simples = mapAccumBagL get [] simples where - get acc ct | Just ct' <- pendingScDict_maybe ct - = (ct':acc, ct') + get acc ct | Just ct_exhausted <- pendingScDict_maybe ct + = (ct:acc, ct_exhausted) | otherwise = (acc, ct) ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -33,6 +33,9 @@ -fbang-patterns -fbuilding-cabal-package -fconstraint-solver-iterations +-fgivens-expansion-fuel +-fwanteds-expansion-fuel +-fqcs-expansion-fuel -fcontext-stack -fcross-module-specialize -fdiagnostics-color=always ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +class C [a] => C a where + foo :: a -> Int + +bar :: C a => a -> Int +bar x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -864,3 +864,5 @@ test('T22924', normal, compile, ['']) test('T22985a', normal, compile, ['-O']) test('T22985b', normal, compile, ['']) test('T23018', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6432eacdac8e8fd135e52b2fb51bcb43b6913c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6432eacdac8e8fd135e52b2fb51bcb43b6913c3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 03:51:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 06 Mar 2023 22:51:21 -0500 Subject: [Git][ghc/ghc][master] Documentation: describe laziness of several function from Data.List Message-ID: <6406b4b97d0cd_3ab52b6dbaccec10451af@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - 2 changed files: - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs Changes: ===================================== libraries/base/Data/OldList.hs ===================================== @@ -233,12 +233,26 @@ infix 5 \\ -- comment to fool cpp: https://downloads.haskell.org/~ghc/latest/doc -- -- >>> dropWhileEnd isSpace "foo\n" -- "foo" --- -- >>> dropWhileEnd isSpace "foo bar" -- "foo bar" --- -- > dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined -- +-- This function is lazy in spine, but strict in elements, +-- which makes it different from 'reverse' '.' 'dropWhile' @p@ '.' 'reverse', +-- which is strict in spine, but lazy in elements. For instance: +-- +-- >>> take 1 (dropWhileEnd (< 0) (1 : undefined)) +-- [1] +-- >>> take 1 (reverse $ dropWhile (< 0) $ reverse (1 : undefined)) +-- *** Exception: Prelude.undefined +-- +-- but on the other hand +-- +-- >>> last (dropWhileEnd (< 0) [undefined, 1]) +-- *** Exception: Prelude.undefined +-- >>> last (reverse $ dropWhile (< 0) $ reverse [undefined, 1]) +-- 1 +-- -- @since 4.5.0.0 dropWhileEnd :: (a -> Bool) -> [a] -> [a] dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] @@ -344,6 +358,11 @@ findIndices p ls = build $ \c n -> -- >>> [0..] `isPrefixOf` [0..] -- * Hangs forever * -- +-- 'isPrefixOf' shortcuts when the first argument is empty: +-- +-- >>> isPrefixOf [] undefined +-- True +-- isPrefixOf :: (Eq a) => [a] -> [a] -> Bool isPrefixOf [] _ = True isPrefixOf _ [] = False @@ -600,6 +619,14 @@ intersectBy eq xs ys = [x | x <- xs, any (eq x) ys] -- -- >>> intersperse ',' "abcde" -- "a,b,c,d,e" +-- +-- 'intersperse' has the following laziness properties: +-- +-- >>> take 1 (intersperse undefined ('a' : undefined)) +-- "a" +-- >>> take 2 (intersperse ',' ('a' : undefined)) +-- "a*** Exception: Prelude.undefined +-- intersperse :: a -> [a] -> [a] intersperse _ [] = [] intersperse sep (x:xs) = x : prependToAll sep xs @@ -619,6 +646,14 @@ prependToAll sep (x:xs) = sep : x : prependToAll sep xs -- -- >>> intercalate ", " ["Lorem", "ipsum", "dolor"] -- "Lorem, ipsum, dolor" +-- +-- 'intercalate' has the following laziness properties: +-- +-- >>> take 5 (intercalate undefined ("Lorem" : undefined)) +-- "Lorem" +-- >>> take 6 (intercalate ", " ("Lorem" : undefined)) +-- "Lorem*** Exception: Prelude.undefined +-- intercalate :: [a] -> [[a]] -> [a] intercalate xs xss = concat (intersperse xs xss) @@ -638,6 +673,11 @@ intercalate xs xss = concat (intersperse xs xss) -- >>> transpose (repeat []) -- * Hangs forever * -- +-- 'transpose' is lazy: +-- +-- >>> take 1 (transpose ['a' : undefined, 'b' : undefined]) +-- ["ab"] +-- transpose :: [[a]] -> [[a]] transpose [] = [] transpose ([] : xss) = transpose xss @@ -708,6 +748,12 @@ select p x ~(ts,fs) | p x = (x:ts,fs) -- 'foldl'; it applies a function to each element of a list, passing -- an accumulating parameter from left to right, and returning a final -- value of this accumulator together with the new list. +-- +-- 'mapAccumL' does not force accumulator if it is unused: +-- +-- >>> take 1 (snd (mapAccumL (\_ x -> (undefined, x)) undefined ('a' : undefined))) +-- "a" +-- mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list -- and accumulator, returning new -- accumulator and elt of result list @@ -1234,6 +1280,13 @@ tails lst = build (\c n -> -- >>> take 8 $ subsequences ['a'..] -- ["","a","b","ab","c","ac","bc","abc"] -- +-- 'subsequences' does not look ahead unless it must: +-- +-- >>> take 1 (subsequences undefined) +-- [[]] +-- >>> take 2 (subsequences ('a' : undefined)) +-- ["","a"] +-- subsequences :: [a] -> [[a]] subsequences xs = [] : nonEmptySubsequences xs @@ -1550,6 +1603,11 @@ singleton x = [x] -- >>> unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10 -- [10,9,8,7,6,5,4,3,2,1] -- +-- Laziness: +-- +-- >>> take 1 (unfoldr (\x -> Just (x, undefined)) 'a') +-- "a" +-- -- Note [INLINE unfoldr] -- ~~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/GHC/List.hs ===================================== @@ -449,8 +449,10 @@ product = foldl' (*) 1 -- [100,99,97,94,90] -- >>> scanl (\reversedString nextChar -> nextChar : reversedString) "foo" ['a', 'b', 'c', 'd'] -- ["foo","afoo","bafoo","cbafoo","dcbafoo"] --- >>> scanl (+) 0 [1..] --- * Hangs forever * +-- >>> take 10 (scanl (+) 0 [1..]) +-- [0,1,3,6,10,15,21,28,36,45] +-- >>> take 1 (scanl undefined 'a' undefined) +-- "a" -- This peculiar arrangement is necessary to prevent scanl being rewritten in -- its own right-hand side. @@ -496,8 +498,10 @@ constScanl = const -- [True,False,False,False] -- >>> scanl1 (||) [False, False, True, True] -- [False,False,True,True] --- >>> scanl1 (+) [1..] --- * Hangs forever * +-- >>> take 10 (scanl1 (+) [1..]) +-- [1,3,6,10,15,21,28,36,45,55] +-- >>> take 1 (scanl1 undefined ('a' : undefined)) +-- "a" scanl1 :: (a -> a -> a) -> [a] -> [a] scanl1 f (x:xs) = scanl f x xs scanl1 _ [] = [] @@ -753,9 +757,12 @@ minimum xs = foldl1' min xs -- variant of this function. -- -- >>> take 10 $ iterate not True --- [True,False,True,False... +-- [True,False,True,False,True,False,True,False,True,False] -- >>> take 10 $ iterate (+3) 42 --- [42,45,48,51,54,57,60,63... +-- [42,45,48,51,54,57,60,63,66,69] +-- >>> take 1 $ iterate undefined 42 +-- [42] +-- {-# NOINLINE [1] iterate #-} iterate :: (a -> a) -> a -> [a] iterate f x = x : iterate f (f x) @@ -776,6 +783,10 @@ iterateFB c f x0 = go x0 -- It forces the result of each application of the function to weak head normal -- form (WHNF) -- before proceeding. +-- +-- >>> take 1 $ iterate' undefined 42 +-- *** Exception: Prelude.undefined +-- {-# NOINLINE [1] iterate' #-} iterate' :: (a -> a) -> a -> [a] iterate' f x = @@ -835,10 +846,13 @@ replicate n x = take n (repeat x) -- -- >>> cycle [] -- *** Exception: Prelude.cycle: empty list --- >>> cycle [42] --- [42,42,42,42,42,42,42,42,42,42... --- >>> cycle [2, 5, 7] --- [2,5,7,2,5,7,2,5,7,2,5,7... +-- >>> take 10 (cycle [42]) +-- [42,42,42,42,42,42,42,42,42,42] +-- >>> take 10 (cycle [2, 5, 7]) +-- [2,5,7,2,5,7,2,5,7,2] +-- >>> take 1 (cycle (42 : undefined)) +-- [42] +-- cycle :: HasCallStack => [a] -> [a] cycle [] = errorEmptyList "cycle" cycle xs = xs' where xs' = xs ++ xs' @@ -852,6 +866,16 @@ cycle xs = xs' where xs' = xs ++ xs' -- [1,2,3] -- >>> takeWhile (< 0) [1,2,3] -- [] +-- +-- Laziness: +-- +-- >>> takeWhile (const False) undefined +-- *** Exception: Prelude.undefined +-- >>> takeWhile (const False) (undefined : undefined) +-- [] +-- >>> take 1 (takeWhile (const True) (1 : undefined)) +-- [1] +-- {-# NOINLINE [1] takeWhile #-} takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile _ [] = [] @@ -908,6 +932,13 @@ dropWhile p xs@(x:xs') -- >>> take 0 [1,2] -- [] -- +-- Laziness: +-- +-- >>> take 0 undefined +-- [] +-- >>> take 1 (1 : undefined) +-- [1] +-- -- It is an instance of the more general 'Data.List.genericTake', -- in which @n@ may be of any integral type. take :: Int -> [a] -> [a] @@ -1018,8 +1049,17 @@ drop n ls -- >>> splitAt (-1) [1,2,3] -- ([],[1,2,3]) -- --- It is equivalent to @('take' n xs, 'drop' n xs)@ when @n@ is not @_|_@ --- (@splitAt _|_ xs = _|_@). +-- It is equivalent to @('take' n xs, 'drop' n xs)@ +-- unless @n@ is @_|_@: +-- @splitAt _|_ xs = _|_@, not @(_|_, _|_)@). +-- +-- The first component of the tuple is produced lazily: +-- +-- >>> fst (splitAt 0 undefined) +-- [] +-- >>> take 1 (fst (splitAt 10 (1 : undefined))) +-- [1] +-- -- 'splitAt' is an instance of the more general 'Data.List.genericSplitAt', -- in which @n@ may be of any integral type. splitAt :: Int -> [a] -> ([a],[a]) @@ -1050,7 +1090,24 @@ splitAt n ls -- >>> span (< 0) [1,2,3] -- ([],[1,2,3]) -- --- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ +-- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@, even if @p@ is @_|_ at . +-- +-- Laziness: +-- +-- >>> span undefined [] +-- ([],[]) +-- >>> fst (span (const False) undefined) +-- *** Exception: Prelude.undefined +-- >>> fst (span (const False) (undefined : undefined)) +-- [] +-- >>> take 1 (fst (span (const True) (1 : undefined))) +-- [1] +-- +-- 'span' produces the first component of the tuple lazily: +-- +-- >>> take 10 (fst (span (const True) [1..])) +-- [1,2,3,4,5,6,7,8,9,10] +-- span :: (a -> Bool) -> [a] -> ([a],[a]) span _ xs@[] = (xs, xs) span p xs@(x:xs') @@ -1068,7 +1125,26 @@ span p xs@(x:xs') -- >>> break (> 9) [1,2,3] -- ([1,2,3],[]) -- --- 'break' @p@ is equivalent to @'span' ('not' . p)@. +-- 'break' @p@ is equivalent to @'span' ('not' . p)@ +-- and consequently to @('takeWhile' ('not' . p) xs, 'dropWhile' ('not' . p) xs)@, +-- even if @p@ is @_|_ at . +-- +-- Laziness: +-- +-- >>> break undefined [] +-- ([],[]) +-- >>> fst (break (const True) undefined) +-- *** Exception: Prelude.undefined +-- >>> fst (break (const True) (undefined : undefined)) +-- [] +-- >>> take 1 (fst (break (const False) (1 : undefined))) +-- [1] +-- +-- 'break' produces the first component of the tuple lazily: +-- +-- >>> take 10 (fst (break (const False) [1..])) +-- [1,2,3,4,5,6,7,8,9,10] +-- break :: (a -> Bool) -> [a] -> ([a],[a]) #if defined(USE_REPORT_PRELUDE) break p = span (not . p) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5afc8ab3c5518aebf8823ed418d404853929147 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5afc8ab3c5518aebf8823ed418d404853929147 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 11:27:50 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 07 Mar 2023 06:27:50 -0500 Subject: [Git][ghc/ghc][wip/romes/no-this-unit-id-aggressive] 3 commits: working this out Message-ID: <64071fb692fba_2c78e910d3a6c951fd@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/no-this-unit-id-aggressive at Glasgow Haskell Compiler / GHC Commits: d8f005d3 by romes at 2023-03-07T09:55:03+00:00 working this out - - - - - 183f975e by romes at 2023-03-07T10:25:43+00:00 Delete wires and unwires map - - - - - ea020879 by romes at 2023-03-07T11:27:10+00:00 Wired in names have type WiredIn Name - - - - - 15 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Ext/Binary.hs - compiler/GHC/Iface/Ext/Debug.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs - + del-this-unit-id.sh - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Rules/ToolArgs.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -198,317 +198,319 @@ names with uniques. These ones are the *non* wired-in ones. The wired in ones are defined in GHC.Builtin.Types etc. -} -basicKnownKeyNames :: [Name] -- See Note [Known-key names] +basicKnownKeyNames :: IO [Name] -- See Note [Known-key names] basicKnownKeyNames - = genericTyConNames - ++ [ -- Classes. *Must* include: - -- classes that are grabbed by key (e.g., eqClassKey) - -- classes in "Class.standardClassKeys" (quite a few) - eqClassName, -- mentioned, derivable - ordClassName, -- derivable - boundedClassName, -- derivable - numClassName, -- mentioned, numeric - enumClassName, -- derivable - monadClassName, - functorClassName, - realClassName, -- numeric - integralClassName, -- numeric - fractionalClassName, -- numeric - floatingClassName, -- numeric - realFracClassName, -- numeric - realFloatClassName, -- numeric - dataClassName, - isStringClassName, - applicativeClassName, - alternativeClassName, - foldableClassName, - traversableClassName, - semigroupClassName, sappendName, - monoidClassName, memptyName, mappendName, mconcatName, - - -- The IO type - ioTyConName, ioDataConName, - runMainIOName, - runRWName, - - -- Type representation types - trModuleTyConName, trModuleDataConName, - trNameTyConName, trNameSDataConName, trNameDDataConName, - trTyConTyConName, trTyConDataConName, - - -- Typeable - typeableClassName, - typeRepTyConName, - someTypeRepTyConName, - someTypeRepDataConName, - kindRepTyConName, - kindRepTyConAppDataConName, - kindRepVarDataConName, - kindRepAppDataConName, - kindRepFunDataConName, - kindRepTYPEDataConName, - kindRepTypeLitSDataConName, - kindRepTypeLitDDataConName, - typeLitSortTyConName, - typeLitSymbolDataConName, - typeLitNatDataConName, - typeLitCharDataConName, - typeRepIdName, - mkTrTypeName, - mkTrConName, - mkTrAppName, - mkTrFunName, - typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName, - trGhcPrimModuleName, - - -- KindReps for common cases - starKindRepName, - starArrStarKindRepName, - starArrStarArrStarKindRepName, - constraintKindRepName, - - -- WithDict - withDictClassName, - - -- Dynamic - toDynName, - - -- Numeric stuff - negateName, minusName, geName, eqName, - mkRationalBase2Name, mkRationalBase10Name, - - -- Conversion functions - rationalTyConName, - ratioTyConName, ratioDataConName, - fromRationalName, fromIntegerName, - toIntegerName, toRationalName, - fromIntegralName, realToFracName, - - -- Int# stuff - divIntName, modIntName, - - -- String stuff - fromStringName, - - -- Enum stuff - enumFromName, enumFromThenName, - enumFromThenToName, enumFromToName, - - -- Applicative stuff - pureAName, apAName, thenAName, - - -- Functor stuff - fmapName, - - -- Monad stuff - thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName, - returnMName, joinMName, - - -- MonadFail - monadFailClassName, failMName, - - -- MonadFix - monadFixClassName, mfixName, - - -- Arrow stuff - arrAName, composeAName, firstAName, - appAName, choiceAName, loopAName, - - -- Ix stuff - ixClassName, - - -- Show stuff - showClassName, - - -- Read stuff - readClassName, - - -- Stable pointers - newStablePtrName, - - -- GHC Extensions - considerAccessibleName, - - -- Strings and lists - unpackCStringName, unpackCStringUtf8Name, - unpackCStringAppendName, unpackCStringAppendUtf8Name, - unpackCStringFoldrName, unpackCStringFoldrUtf8Name, - cstringLengthName, - - -- Overloaded lists - isListClassName, - fromListName, - fromListNName, - toListName, - - -- Non-empty lists - nonEmptyTyConName, - - -- Overloaded record dot, record update - getFieldName, setFieldName, - - -- List operations - concatName, filterName, mapName, - zipName, foldrName, buildName, augmentName, appendName, - - -- FFI primitive types that are not wired-in. - stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName, - int8TyConName, int16TyConName, int32TyConName, int64TyConName, - word8TyConName, word16TyConName, word32TyConName, word64TyConName, - - -- Others - otherwiseIdName, inlineIdName, - eqStringName, assertName, - assertErrorName, traceName, - printName, - dollarName, - - -- ghc-bignum - integerFromNaturalName, - integerToNaturalClampName, - integerToNaturalThrowName, - integerToNaturalName, - integerToWordName, - integerToIntName, - integerToWord64Name, - integerToInt64Name, - integerFromWordName, - integerFromWord64Name, - integerFromInt64Name, - integerAddName, - integerMulName, - integerSubName, - integerNegateName, - integerAbsName, - integerPopCountName, - integerQuotName, - integerRemName, - integerDivName, - integerModName, - integerDivModName, - integerQuotRemName, - integerEncodeFloatName, - integerEncodeDoubleName, - integerGcdName, - integerLcmName, - integerAndName, - integerOrName, - integerXorName, - integerComplementName, - integerBitName, - integerTestBitName, - integerShiftLName, - integerShiftRName, - - naturalToWordName, - naturalPopCountName, - naturalShiftRName, - naturalShiftLName, - naturalAddName, - naturalSubName, - naturalSubThrowName, - naturalSubUnsafeName, - naturalMulName, - naturalQuotRemName, - naturalQuotName, - naturalRemName, - naturalAndName, - naturalAndNotName, - naturalOrName, - naturalXorName, - naturalTestBitName, - naturalBitName, - naturalGcdName, - naturalLcmName, - naturalLog2Name, - naturalLogBaseWordName, - naturalLogBaseName, - naturalPowModName, - naturalSizeInBaseName, - - bignatFromWordListName, - bignatEqName, - - -- Float/Double - integerToFloatName, - integerToDoubleName, - naturalToFloatName, - naturalToDoubleName, - rationalToFloatName, - rationalToDoubleName, - - -- Other classes - monadPlusClassName, - - -- Type-level naturals - knownNatClassName, knownSymbolClassName, knownCharClassName, - - -- Overloaded labels - fromLabelClassOpName, - - -- Implicit Parameters - ipClassName, - - -- Overloaded record fields - hasFieldClassName, - - -- Call Stacks - callStackTyConName, - emptyCallStackName, pushCallStackName, - - -- Source Locations - srcLocDataConName, - - -- Annotation type checking - toAnnotationWrapperName - - -- The SPEC type for SpecConstr - , specTyConName - - -- The Either type - , eitherTyConName, leftDataConName, rightDataConName - - -- The Void type - , voidTyConName - + = sequence [ -- Plugins - , pluginTyConName + pluginTyConName , frontendPluginTyConName - - -- Generics - , genClassName, gen1ClassName - , datatypeClassName, constructorClassName, selectorClassName - - -- Monad comprehensions - , guardMName - , liftMName - , mzipName - - -- GHCi Sandbox - , ghciIoClassName, ghciStepIoMName - - -- StaticPtr - , makeStaticName - , staticPtrTyConName - , staticPtrDataConName, staticPtrInfoDataConName - , fromStaticPtrName - - -- Fingerprint - , fingerprintDataConName - - -- Custom type errors - , errorMessageTypeErrorFamName - , typeErrorTextDataConName - , typeErrorAppendDataConName - , typeErrorVAppendDataConName - , typeErrorShowTypeDataConName - - -- Unsafe coercion proofs - , unsafeEqualityProofName - , unsafeEqualityTyConName - , unsafeReflDataConName - , unsafeCoercePrimName - ] + ] >>= \ioknownnames -> + pure (ioknownnames ++ + genericTyConNames + ++ [ -- Classes. *Must* include: + -- classes that are grabbed by key (e.g., eqClassKey) + -- classes in "Class.standardClassKeys" (quite a few) + eqClassName, -- mentioned, derivable + ordClassName, -- derivable + boundedClassName, -- derivable + numClassName, -- mentioned, numeric + enumClassName, -- derivable + monadClassName, + functorClassName, + realClassName, -- numeric + integralClassName, -- numeric + fractionalClassName, -- numeric + floatingClassName, -- numeric + realFracClassName, -- numeric + realFloatClassName, -- numeric + dataClassName, + isStringClassName, + applicativeClassName, + alternativeClassName, + foldableClassName, + traversableClassName, + semigroupClassName, sappendName, + monoidClassName, memptyName, mappendName, mconcatName, + + -- The IO type + ioTyConName, ioDataConName, + runMainIOName, + runRWName, + + -- Type representation types + trModuleTyConName, trModuleDataConName, + trNameTyConName, trNameSDataConName, trNameDDataConName, + trTyConTyConName, trTyConDataConName, + + -- Typeable + typeableClassName, + typeRepTyConName, + someTypeRepTyConName, + someTypeRepDataConName, + kindRepTyConName, + kindRepTyConAppDataConName, + kindRepVarDataConName, + kindRepAppDataConName, + kindRepFunDataConName, + kindRepTYPEDataConName, + kindRepTypeLitSDataConName, + kindRepTypeLitDDataConName, + typeLitSortTyConName, + typeLitSymbolDataConName, + typeLitNatDataConName, + typeLitCharDataConName, + typeRepIdName, + mkTrTypeName, + mkTrConName, + mkTrAppName, + mkTrFunName, + typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName, + trGhcPrimModuleName, + + -- KindReps for common cases + starKindRepName, + starArrStarKindRepName, + starArrStarArrStarKindRepName, + constraintKindRepName, + + -- WithDict + withDictClassName, + + -- Dynamic + toDynName, + + -- Numeric stuff + negateName, minusName, geName, eqName, + mkRationalBase2Name, mkRationalBase10Name, + + -- Conversion functions + rationalTyConName, + ratioTyConName, ratioDataConName, + fromRationalName, fromIntegerName, + toIntegerName, toRationalName, + fromIntegralName, realToFracName, + + -- Int# stuff + divIntName, modIntName, + + -- String stuff + fromStringName, + + -- Enum stuff + enumFromName, enumFromThenName, + enumFromThenToName, enumFromToName, + + -- Applicative stuff + pureAName, apAName, thenAName, + + -- Functor stuff + fmapName, + + -- Monad stuff + thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName, + returnMName, joinMName, + + -- MonadFail + monadFailClassName, failMName, + + -- MonadFix + monadFixClassName, mfixName, + + -- Arrow stuff + arrAName, composeAName, firstAName, + appAName, choiceAName, loopAName, + + -- Ix stuff + ixClassName, + + -- Show stuff + showClassName, + + -- Read stuff + readClassName, + + -- Stable pointers + newStablePtrName, + + -- GHC Extensions + considerAccessibleName, + + -- Strings and lists + unpackCStringName, unpackCStringUtf8Name, + unpackCStringAppendName, unpackCStringAppendUtf8Name, + unpackCStringFoldrName, unpackCStringFoldrUtf8Name, + cstringLengthName, + + -- Overloaded lists + isListClassName, + fromListName, + fromListNName, + toListName, + + -- Non-empty lists + nonEmptyTyConName, + + -- Overloaded record dot, record update + getFieldName, setFieldName, + + -- List operations + concatName, filterName, mapName, + zipName, foldrName, buildName, augmentName, appendName, + + -- FFI primitive types that are not wired-in. + stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName, + int8TyConName, int16TyConName, int32TyConName, int64TyConName, + word8TyConName, word16TyConName, word32TyConName, word64TyConName, + + -- Others + otherwiseIdName, inlineIdName, + eqStringName, assertName, + assertErrorName, traceName, + printName, + dollarName, + + -- ghc-bignum + integerFromNaturalName, + integerToNaturalClampName, + integerToNaturalThrowName, + integerToNaturalName, + integerToWordName, + integerToIntName, + integerToWord64Name, + integerToInt64Name, + integerFromWordName, + integerFromWord64Name, + integerFromInt64Name, + integerAddName, + integerMulName, + integerSubName, + integerNegateName, + integerAbsName, + integerPopCountName, + integerQuotName, + integerRemName, + integerDivName, + integerModName, + integerDivModName, + integerQuotRemName, + integerEncodeFloatName, + integerEncodeDoubleName, + integerGcdName, + integerLcmName, + integerAndName, + integerOrName, + integerXorName, + integerComplementName, + integerBitName, + integerTestBitName, + integerShiftLName, + integerShiftRName, + + naturalToWordName, + naturalPopCountName, + naturalShiftRName, + naturalShiftLName, + naturalAddName, + naturalSubName, + naturalSubThrowName, + naturalSubUnsafeName, + naturalMulName, + naturalQuotRemName, + naturalQuotName, + naturalRemName, + naturalAndName, + naturalAndNotName, + naturalOrName, + naturalXorName, + naturalTestBitName, + naturalBitName, + naturalGcdName, + naturalLcmName, + naturalLog2Name, + naturalLogBaseWordName, + naturalLogBaseName, + naturalPowModName, + naturalSizeInBaseName, + + bignatFromWordListName, + bignatEqName, + + -- Float/Double + integerToFloatName, + integerToDoubleName, + naturalToFloatName, + naturalToDoubleName, + rationalToFloatName, + rationalToDoubleName, + + -- Other classes + monadPlusClassName, + + -- Type-level naturals + knownNatClassName, knownSymbolClassName, knownCharClassName, + + -- Overloaded labels + fromLabelClassOpName, + + -- Implicit Parameters + ipClassName, + + -- Overloaded record fields + hasFieldClassName, + + -- Call Stacks + callStackTyConName, + emptyCallStackName, pushCallStackName, + + -- Source Locations + srcLocDataConName, + + -- Annotation type checking + toAnnotationWrapperName + + -- The SPEC type for SpecConstr + , specTyConName + + -- The Either type + , eitherTyConName, leftDataConName, rightDataConName + + -- The Void type + , voidTyConName + + -- Generics + , genClassName, gen1ClassName + , datatypeClassName, constructorClassName, selectorClassName + + -- Monad comprehensions + , guardMName + , liftMName + , mzipName + + -- GHCi Sandbox + , ghciIoClassName, ghciStepIoMName + + -- StaticPtr + , makeStaticName + , staticPtrTyConName + , staticPtrDataConName, staticPtrInfoDataConName + , fromStaticPtrName + + -- Fingerprint + , fingerprintDataConName + + -- Custom type errors + , errorMessageTypeErrorFamName + , typeErrorTextDataConName + , typeErrorAppendDataConName + , typeErrorVAppendDataConName + , typeErrorShowTypeDataConName + + -- Unsafe coercion proofs + , unsafeEqualityProofName + , unsafeEqualityTyConName + , unsafeReflDataConName + , unsafeCoercePrimName + ]) genericTyConNames :: [Name] genericTyConNames = [ @@ -540,7 +542,7 @@ genericTyConNames = [ --MetaHaskell Extension Add a new module here -} -pRELUDE :: Module +pRELUDE :: WiredIn Module pRELUDE = mkBaseModule_ pRELUDE_NAME gHC_PRIM, gHC_PRIM_PANIC, @@ -559,7 +561,7 @@ gHC_PRIM, gHC_PRIM_PANIC, aRROW, gHC_DESUGAR, rANDOM, gHC_EXTS, gHC_IS_LIST, cONTROL_EXCEPTION_BASE, gHC_TYPEERROR, gHC_TYPELITS, gHC_TYPELITS_INTERNAL, gHC_TYPENATS, gHC_TYPENATS_INTERNAL, - dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE, fOREIGN_C_CONSTPTR :: Module + dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE, fOREIGN_C_CONSTPTR :: WiredIn Module gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values gHC_PRIM_PANIC = mkPrimModule (fsLit "GHC.Prim.Panic") @@ -630,26 +632,26 @@ dEBUG_TRACE = mkBaseModule (fsLit "Debug.Trace") uNSAFE_COERCE = mkBaseModule (fsLit "Unsafe.Coerce") fOREIGN_C_CONSTPTR = mkBaseModule (fsLit "Foreign.C.ConstPtr") -gHC_SRCLOC :: Module +gHC_SRCLOC :: WiredIn Module gHC_SRCLOC = mkBaseModule (fsLit "GHC.SrcLoc") -gHC_STACK, gHC_STACK_TYPES :: Module +gHC_STACK, gHC_STACK_TYPES :: WiredIn Module gHC_STACK = mkBaseModule (fsLit "GHC.Stack") gHC_STACK_TYPES = mkBaseModule (fsLit "GHC.Stack.Types") -gHC_STATICPTR :: Module +gHC_STATICPTR :: WiredIn Module gHC_STATICPTR = mkBaseModule (fsLit "GHC.StaticPtr") -gHC_STATICPTR_INTERNAL :: Module +gHC_STATICPTR_INTERNAL :: WiredIn Module gHC_STATICPTR_INTERNAL = mkBaseModule (fsLit "GHC.StaticPtr.Internal") -gHC_FINGERPRINT_TYPE :: Module +gHC_FINGERPRINT_TYPE :: WiredIn Module gHC_FINGERPRINT_TYPE = mkBaseModule (fsLit "GHC.Fingerprint.Type") -gHC_OVER_LABELS :: Module +gHC_OVER_LABELS :: WiredIn Module gHC_OVER_LABELS = mkBaseModule (fsLit "GHC.OverloadedLabels") -gHC_RECORDS :: Module +gHC_RECORDS :: WiredIn Module gHC_RECORDS = mkBaseModule (fsLit "GHC.Records") rOOT_MAIN :: Module @@ -663,23 +665,23 @@ pRELUDE_NAME, mAIN_NAME :: ModuleName pRELUDE_NAME = mkModuleNameFS (fsLit "Prelude") mAIN_NAME = mkModuleNameFS (fsLit "Main") -mkPrimModule :: FastString -> Module -mkPrimModule m = mkModule primUnit (mkModuleNameFS m) +mkPrimModule :: FastString -> WiredIn Module +mkPrimModule m = mkModule <$> primUnit <*> pure (mkModuleNameFS m) -mkBignumModule :: FastString -> Module -mkBignumModule m = mkModule bignumUnit (mkModuleNameFS m) +mkBignumModule :: FastString -> WiredIn Module +mkBignumModule m = mkModule <$> bignumUnit <*> pure (mkModuleNameFS m) -mkBaseModule :: FastString -> Module +mkBaseModule :: FastString -> WiredIn Module mkBaseModule m = mkBaseModule_ (mkModuleNameFS m) -mkBaseModule_ :: ModuleName -> Module -mkBaseModule_ m = mkModule baseUnit m +mkBaseModule_ :: ModuleName -> WiredIn Module +mkBaseModule_ m = mkModule <$> baseUnit <*> pure m -mkThisGhcModule :: FastString -> Module +mkThisGhcModule :: FastString -> WiredIn Module mkThisGhcModule m = mkThisGhcModule_ (mkModuleNameFS m) -mkThisGhcModule_ :: ModuleName -> Module -mkThisGhcModule_ m = mkModule thisGhcUnit m +mkThisGhcModule_ :: ModuleName -> WiredIn Module +mkThisGhcModule_ m = mkModule <$> thisGhcUnit <*> pure m mkMainModule :: FastString -> Module mkMainModule m = mkModule mainUnit (mkModuleNameFS m) @@ -700,14 +702,14 @@ main_RDR_Unqual = mkUnqual varName (fsLit "main") -- We definitely don't want an Orig RdrName, because -- main might, in principle, be imported into module Main -eq_RDR, ge_RDR, le_RDR, lt_RDR, gt_RDR, compare_RDR, - ltTag_RDR, eqTag_RDR, gtTag_RDR :: RdrName +le_RDR, lt_RDR, gt_RDR, compare_RDR :: WiredIn RdrName +le_RDR = varQual_RDR <$> gHC_CLASSES <*> pure (fsLit "<=") +lt_RDR = varQual_RDR <$> gHC_CLASSES <*> pure (fsLit "<") +gt_RDR = varQual_RDR <$> gHC_CLASSES <*> pure (fsLit ">") +compare_RDR = varQual_RDR <$> gHC_CLASSES <*> pure (fsLit "compare") +eq_RDR, ge_RDR, ltTag_RDR, eqTag_RDR, gtTag_RDR :: RdrName eq_RDR = nameRdrName eqName ge_RDR = nameRdrName geName -le_RDR = varQual_RDR gHC_CLASSES (fsLit "<=") -lt_RDR = varQual_RDR gHC_CLASSES (fsLit "<") -gt_RDR = varQual_RDR gHC_CLASSES (fsLit ">") -compare_RDR = varQual_RDR gHC_CLASSES (fsLit "compare") ltTag_RDR = nameRdrName ordLTDataConName eqTag_RDR = nameRdrName ordEQDataConName gtTag_RDR = nameRdrName ordGTDataConName @@ -736,9 +738,9 @@ left_RDR, right_RDR :: RdrName left_RDR = nameRdrName leftDataConName right_RDR = nameRdrName rightDataConName -fromEnum_RDR, toEnum_RDR :: RdrName -fromEnum_RDR = varQual_RDR gHC_ENUM (fsLit "fromEnum") -toEnum_RDR = varQual_RDR gHC_ENUM (fsLit "toEnum") +fromEnum_RDR, toEnum_RDR :: WiredIn RdrName +fromEnum_RDR = varQual_RDR <$> gHC_ENUM <*> pure (fsLit "fromEnum") +toEnum_RDR = varQual_RDR <$> gHC_ENUM <*> pure (fsLit "toEnum") enumFrom_RDR, enumFromTo_RDR, enumFromThen_RDR, enumFromThenTo_RDR :: RdrName enumFrom_RDR = nameRdrName enumFromName @@ -761,12 +763,13 @@ bindIO_RDR, returnIO_RDR :: RdrName bindIO_RDR = nameRdrName bindIOName returnIO_RDR = nameRdrName returnIOName -fromInteger_RDR, fromRational_RDR, minus_RDR, times_RDR, plus_RDR :: RdrName +fromInteger_RDR, fromRational_RDR, minus_RDR :: RdrName fromInteger_RDR = nameRdrName fromIntegerName fromRational_RDR = nameRdrName fromRationalName minus_RDR = nameRdrName minusName -times_RDR = varQual_RDR gHC_NUM (fsLit "*") -plus_RDR = varQual_RDR gHC_NUM (fsLit "+") +times_RDR, plus_RDR :: WiredIn RdrName +times_RDR = varQual_RDR <$> gHC_NUM <*> pure (fsLit "*") +plus_RDR = varQual_RDR <$> gHC_NUM <*> pure (fsLit "+") toInteger_RDR, toRational_RDR, fromIntegral_RDR :: RdrName toInteger_RDR = nameRdrName toIntegerName @@ -781,65 +784,65 @@ fromList_RDR = nameRdrName fromListName fromListN_RDR = nameRdrName fromListNName toList_RDR = nameRdrName toListName -compose_RDR :: RdrName -compose_RDR = varQual_RDR gHC_BASE (fsLit ".") +compose_RDR :: WiredIn RdrName +compose_RDR = varQual_RDR <$> gHC_BASE <*> pure (fsLit ".") not_RDR, dataToTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, and_RDR, range_RDR, inRange_RDR, index_RDR, - unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName -and_RDR = varQual_RDR gHC_CLASSES (fsLit "&&") -not_RDR = varQual_RDR gHC_CLASSES (fsLit "not") -dataToTag_RDR = varQual_RDR gHC_PRIM (fsLit "dataToTag#") -succ_RDR = varQual_RDR gHC_ENUM (fsLit "succ") -pred_RDR = varQual_RDR gHC_ENUM (fsLit "pred") -minBound_RDR = varQual_RDR gHC_ENUM (fsLit "minBound") -maxBound_RDR = varQual_RDR gHC_ENUM (fsLit "maxBound") -range_RDR = varQual_RDR gHC_IX (fsLit "range") -inRange_RDR = varQual_RDR gHC_IX (fsLit "inRange") -index_RDR = varQual_RDR gHC_IX (fsLit "index") -unsafeIndex_RDR = varQual_RDR gHC_IX (fsLit "unsafeIndex") -unsafeRangeSize_RDR = varQual_RDR gHC_IX (fsLit "unsafeRangeSize") + unsafeIndex_RDR, unsafeRangeSize_RDR :: WiredIn RdrName +and_RDR = varQual_RDR <$> gHC_CLASSES <*> pure (fsLit "&&") +not_RDR = varQual_RDR <$> gHC_CLASSES <*> pure (fsLit "not") +dataToTag_RDR = varQual_RDR <$> gHC_PRIM <*> pure (fsLit "dataToTag#") +succ_RDR = varQual_RDR <$> gHC_ENUM <*> pure (fsLit "succ") +pred_RDR = varQual_RDR <$> gHC_ENUM <*> pure (fsLit "pred") +minBound_RDR = varQual_RDR <$> gHC_ENUM <*> pure (fsLit "minBound") +maxBound_RDR = varQual_RDR <$> gHC_ENUM <*> pure (fsLit "maxBound") +range_RDR = varQual_RDR <$> gHC_IX <*> pure (fsLit "range") +inRange_RDR = varQual_RDR <$> gHC_IX <*> pure (fsLit "inRange") +index_RDR = varQual_RDR <$> gHC_IX <*> pure (fsLit "index") +unsafeIndex_RDR = varQual_RDR <$> gHC_IX <*> pure (fsLit "unsafeIndex") +unsafeRangeSize_RDR = varQual_RDR <$> gHC_IX <*> pure (fsLit "unsafeRangeSize") readList_RDR, readListDefault_RDR, readListPrec_RDR, readListPrecDefault_RDR, - readPrec_RDR, parens_RDR, choose_RDR, lexP_RDR, expectP_RDR :: RdrName -readList_RDR = varQual_RDR gHC_READ (fsLit "readList") -readListDefault_RDR = varQual_RDR gHC_READ (fsLit "readListDefault") -readListPrec_RDR = varQual_RDR gHC_READ (fsLit "readListPrec") -readListPrecDefault_RDR = varQual_RDR gHC_READ (fsLit "readListPrecDefault") -readPrec_RDR = varQual_RDR gHC_READ (fsLit "readPrec") -parens_RDR = varQual_RDR gHC_READ (fsLit "parens") -choose_RDR = varQual_RDR gHC_READ (fsLit "choose") -lexP_RDR = varQual_RDR gHC_READ (fsLit "lexP") -expectP_RDR = varQual_RDR gHC_READ (fsLit "expectP") - -readField_RDR, readFieldHash_RDR, readSymField_RDR :: RdrName -readField_RDR = varQual_RDR gHC_READ (fsLit "readField") -readFieldHash_RDR = varQual_RDR gHC_READ (fsLit "readFieldHash") -readSymField_RDR = varQual_RDR gHC_READ (fsLit "readSymField") - -punc_RDR, ident_RDR, symbol_RDR :: RdrName -punc_RDR = dataQual_RDR lEX (fsLit "Punc") -ident_RDR = dataQual_RDR lEX (fsLit "Ident") -symbol_RDR = dataQual_RDR lEX (fsLit "Symbol") - -step_RDR, alt_RDR, reset_RDR, prec_RDR, pfail_RDR :: RdrName -step_RDR = varQual_RDR rEAD_PREC (fsLit "step") -alt_RDR = varQual_RDR rEAD_PREC (fsLit "+++") -reset_RDR = varQual_RDR rEAD_PREC (fsLit "reset") -prec_RDR = varQual_RDR rEAD_PREC (fsLit "prec") -pfail_RDR = varQual_RDR rEAD_PREC (fsLit "pfail") + readPrec_RDR, parens_RDR, choose_RDR, lexP_RDR, expectP_RDR :: WiredIn RdrName +readList_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readList") +readListDefault_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readListDefault") +readListPrec_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readListPrec") +readListPrecDefault_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readListPrecDefault") +readPrec_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readPrec") +parens_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "parens") +choose_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "choose") +lexP_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "lexP") +expectP_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "expectP") + +readField_RDR, readFieldHash_RDR, readSymField_RDR :: WiredIn RdrName +readField_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readField") +readFieldHash_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readFieldHash") +readSymField_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readSymField") + +punc_RDR, ident_RDR, symbol_RDR :: WiredIn RdrName +punc_RDR = dataQual_RDR <$> lEX <*> pure (fsLit "Punc") +ident_RDR = dataQual_RDR <$> lEX <*> pure (fsLit "Ident") +symbol_RDR = dataQual_RDR <$> lEX <*> pure (fsLit "Symbol") + +step_RDR, alt_RDR, reset_RDR, prec_RDR, pfail_RDR :: WiredIn RdrName +step_RDR = varQual_RDR <$> rEAD_PREC <*> pure (fsLit "step") +alt_RDR = varQual_RDR <$> rEAD_PREC <*> pure (fsLit "+++") +reset_RDR = varQual_RDR <$> rEAD_PREC <*> pure (fsLit "reset") +prec_RDR = varQual_RDR <$> rEAD_PREC <*> pure (fsLit "prec") +pfail_RDR = varQual_RDR <$> rEAD_PREC <*> pure (fsLit "pfail") showsPrec_RDR, shows_RDR, showString_RDR, - showSpace_RDR, showCommaSpace_RDR, showParen_RDR :: RdrName -showsPrec_RDR = varQual_RDR gHC_SHOW (fsLit "showsPrec") -shows_RDR = varQual_RDR gHC_SHOW (fsLit "shows") -showString_RDR = varQual_RDR gHC_SHOW (fsLit "showString") -showSpace_RDR = varQual_RDR gHC_SHOW (fsLit "showSpace") -showCommaSpace_RDR = varQual_RDR gHC_SHOW (fsLit "showCommaSpace") -showParen_RDR = varQual_RDR gHC_SHOW (fsLit "showParen") + showSpace_RDR, showCommaSpace_RDR, showParen_RDR :: WiredIn RdrName +showsPrec_RDR = varQual_RDR <$> gHC_SHOW <*> pure (fsLit "showsPrec") +shows_RDR = varQual_RDR <$> gHC_SHOW <*> pure (fsLit "shows") +showString_RDR = varQual_RDR <$> gHC_SHOW <*> pure (fsLit "showString") +showSpace_RDR = varQual_RDR <$> gHC_SHOW <*> pure (fsLit "showSpace") +showCommaSpace_RDR = varQual_RDR <$> gHC_SHOW <*> pure (fsLit "showCommaSpace") +showParen_RDR = varQual_RDR <$> gHC_SHOW <*> pure (fsLit "showParen") -error_RDR :: RdrName -error_RDR = varQual_RDR gHC_ERR (fsLit "error") +error_RDR :: WiredIn RdrName +error_RDR = varQual_RDR <$> gHC_ERR <*> pure (fsLit "error") -- Generics (constructors and functions) u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR, @@ -854,72 +857,72 @@ u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR, uAddrDataCon_RDR, uCharDataCon_RDR, uDoubleDataCon_RDR, uFloatDataCon_RDR, uIntDataCon_RDR, uWordDataCon_RDR, uAddrHash_RDR, uCharHash_RDR, uDoubleHash_RDR, - uFloatHash_RDR, uIntHash_RDR, uWordHash_RDR :: RdrName - -u1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "U1") -par1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Par1") -rec1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Rec1") -k1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "K1") -m1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "M1") - -l1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "L1") -r1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "R1") - -prodDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit ":*:") -comp1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Comp1") - -unPar1_RDR = varQual_RDR gHC_GENERICS (fsLit "unPar1") -unRec1_RDR = varQual_RDR gHC_GENERICS (fsLit "unRec1") -unK1_RDR = varQual_RDR gHC_GENERICS (fsLit "unK1") -unComp1_RDR = varQual_RDR gHC_GENERICS (fsLit "unComp1") - -from_RDR = varQual_RDR gHC_GENERICS (fsLit "from") -from1_RDR = varQual_RDR gHC_GENERICS (fsLit "from1") -to_RDR = varQual_RDR gHC_GENERICS (fsLit "to") -to1_RDR = varQual_RDR gHC_GENERICS (fsLit "to1") - -datatypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "datatypeName") -moduleName_RDR = varQual_RDR gHC_GENERICS (fsLit "moduleName") -packageName_RDR = varQual_RDR gHC_GENERICS (fsLit "packageName") -isNewtypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "isNewtype") -selName_RDR = varQual_RDR gHC_GENERICS (fsLit "selName") -conName_RDR = varQual_RDR gHC_GENERICS (fsLit "conName") -conFixity_RDR = varQual_RDR gHC_GENERICS (fsLit "conFixity") -conIsRecord_RDR = varQual_RDR gHC_GENERICS (fsLit "conIsRecord") - -prefixDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Prefix") -infixDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Infix") + uFloatHash_RDR, uIntHash_RDR, uWordHash_RDR :: WiredIn RdrName + +u1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "U1") +par1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "Par1") +rec1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "Rec1") +k1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "K1") +m1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "M1") + +l1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "L1") +r1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "R1") + +prodDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit ":*:") +comp1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "Comp1") + +unPar1_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "unPar1") +unRec1_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "unRec1") +unK1_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "unK1") +unComp1_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "unComp1") + +from_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "from") +from1_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "from1") +to_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "to") +to1_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "to1") + +datatypeName_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "datatypeName") +moduleName_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "moduleName") +packageName_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "packageName") +isNewtypeName_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "isNewtype") +selName_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "selName") +conName_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "conName") +conFixity_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "conFixity") +conIsRecord_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "conIsRecord") + +prefixDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "Prefix") +infixDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "Infix") leftAssocDataCon_RDR = nameRdrName leftAssociativeDataConName rightAssocDataCon_RDR = nameRdrName rightAssociativeDataConName notAssocDataCon_RDR = nameRdrName notAssociativeDataConName -uAddrDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UAddr") -uCharDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UChar") -uDoubleDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UDouble") -uFloatDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UFloat") -uIntDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UInt") -uWordDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UWord") +uAddrDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "UAddr") +uCharDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "UChar") +uDoubleDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "UDouble") +uFloatDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "UFloat") +uIntDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "UInt") +uWordDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "UWord") -uAddrHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uAddr#") -uCharHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uChar#") -uDoubleHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uDouble#") -uFloatHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uFloat#") -uIntHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uInt#") -uWordHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uWord#") +uAddrHash_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "uAddr#") +uCharHash_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "uChar#") +uDoubleHash_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "uDouble#") +uFloatHash_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "uFloat#") +uIntHash_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "uInt#") +uWordHash_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "uWord#") fmap_RDR, replace_RDR, pure_RDR, ap_RDR, liftA2_RDR, foldable_foldr_RDR, foldMap_RDR, null_RDR, all_RDR, traverse_RDR, mempty_RDR, - mappend_RDR :: RdrName + mappend_RDR :: WiredIn RdrName fmap_RDR = nameRdrName fmapName -replace_RDR = varQual_RDR gHC_BASE (fsLit "<$") +replace_RDR = varQual_RDR <$> gHC_BASE <*> pure (fsLit "<$") pure_RDR = nameRdrName pureAName ap_RDR = nameRdrName apAName -liftA2_RDR = varQual_RDR gHC_BASE (fsLit "liftA2") -foldable_foldr_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldr") -foldMap_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldMap") -null_RDR = varQual_RDR dATA_FOLDABLE (fsLit "null") -all_RDR = varQual_RDR dATA_FOLDABLE (fsLit "all") -traverse_RDR = varQual_RDR dATA_TRAVERSABLE (fsLit "traverse") +liftA2_RDR = varQual_RDR <$> gHC_BASE <*> pure (fsLit "liftA2") +foldable_foldr_RDR = varQual_RDR <$> dATA_FOLDABLE <*> pure (fsLit "foldr") +foldMap_RDR = varQual_RDR <$> dATA_FOLDABLE <*> pure (fsLit "foldMap") +null_RDR = varQual_RDR <$> dATA_FOLDABLE <*> pure (fsLit "null") +all_RDR = varQual_RDR <$> dATA_FOLDABLE <*> pure (fsLit "all") +traverse_RDR = varQual_RDR <$> dATA_TRAVERSABLE <*> pure (fsLit "traverse") mempty_RDR = nameRdrName memptyName mappend_RDR = nameRdrName mappendName @@ -946,26 +949,26 @@ and it's convenient to write them all down in one place. wildCardName :: Name wildCardName = mkSystemVarName wildCardKey (fsLit "wild") -runMainIOName, runRWName :: Name -runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey -runRWName = varQual gHC_MAGIC (fsLit "runRW#") runRWKey +runMainIOName, runRWName :: WiredIn Name +runMainIOName = varQual <$> gHC_TOP_HANDLER <*> pure (fsLit "runMainIO") runMainKey +runRWName = varQual <$> gHC_MAGIC <*> pure (fsLit "runRW#") runRWKey -orderingTyConName, ordLTDataConName, ordEQDataConName, ordGTDataConName :: Name -orderingTyConName = tcQual gHC_TYPES (fsLit "Ordering") orderingTyConKey -ordLTDataConName = dcQual gHC_TYPES (fsLit "LT") ordLTDataConKey -ordEQDataConName = dcQual gHC_TYPES (fsLit "EQ") ordEQDataConKey -ordGTDataConName = dcQual gHC_TYPES (fsLit "GT") ordGTDataConKey +orderingTyConName, ordLTDataConName, ordEQDataConName, ordGTDataConName :: WiredIn Name +orderingTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "Ordering") <*> pure orderingTyConKey +ordLTDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "LT") <*> pure ordLTDataConKey +ordEQDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "EQ") <*> pure ordEQDataConKey +ordGTDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "GT") <*> pure ordGTDataConKey -specTyConName :: Name -specTyConName = tcQual gHC_TYPES (fsLit "SPEC") specTyConKey +specTyConName :: WiredIn Name +specTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "SPEC") <*> pure specTyConKey -eitherTyConName, leftDataConName, rightDataConName :: Name -eitherTyConName = tcQual dATA_EITHER (fsLit "Either") eitherTyConKey -leftDataConName = dcQual dATA_EITHER (fsLit "Left") leftDataConKey -rightDataConName = dcQual dATA_EITHER (fsLit "Right") rightDataConKey +eitherTyConName, leftDataConName, rightDataConName :: WiredIn Name +eitherTyConName = tcQual <$> dATA_EITHER <*> pure (fsLit "Either") <*> pure eitherTyConKey +leftDataConName = dcQual <$> dATA_EITHER <*> pure (fsLit "Left") <*> pure leftDataConKey +rightDataConName = dcQual <$> dATA_EITHER <*> pure (fsLit "Right") <*> pure rightDataConKey -voidTyConName :: Name -voidTyConName = tcQual gHC_BASE (fsLit "Void") voidTyConKey +voidTyConName :: WiredIn Name +voidTyConName = tcQual <$> gHC_BASE <*> pure (fsLit "Void") <*> pure voidTyConKey -- Generics (types) v1TyConName, u1TyConName, par1TyConName, rec1TyConName, @@ -982,136 +985,136 @@ v1TyConName, u1TyConName, par1TyConName, rec1TyConName, noSourceUnpackednessDataConName, sourceLazyDataConName, sourceStrictDataConName, noSourceStrictnessDataConName, decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName, - metaDataDataConName, metaConsDataConName, metaSelDataConName :: Name - -v1TyConName = tcQual gHC_GENERICS (fsLit "V1") v1TyConKey -u1TyConName = tcQual gHC_GENERICS (fsLit "U1") u1TyConKey -par1TyConName = tcQual gHC_GENERICS (fsLit "Par1") par1TyConKey -rec1TyConName = tcQual gHC_GENERICS (fsLit "Rec1") rec1TyConKey -k1TyConName = tcQual gHC_GENERICS (fsLit "K1") k1TyConKey -m1TyConName = tcQual gHC_GENERICS (fsLit "M1") m1TyConKey - -sumTyConName = tcQual gHC_GENERICS (fsLit ":+:") sumTyConKey -prodTyConName = tcQual gHC_GENERICS (fsLit ":*:") prodTyConKey -compTyConName = tcQual gHC_GENERICS (fsLit ":.:") compTyConKey - -rTyConName = tcQual gHC_GENERICS (fsLit "R") rTyConKey -dTyConName = tcQual gHC_GENERICS (fsLit "D") dTyConKey -cTyConName = tcQual gHC_GENERICS (fsLit "C") cTyConKey -sTyConName = tcQual gHC_GENERICS (fsLit "S") sTyConKey - -rec0TyConName = tcQual gHC_GENERICS (fsLit "Rec0") rec0TyConKey -d1TyConName = tcQual gHC_GENERICS (fsLit "D1") d1TyConKey -c1TyConName = tcQual gHC_GENERICS (fsLit "C1") c1TyConKey -s1TyConName = tcQual gHC_GENERICS (fsLit "S1") s1TyConKey - -repTyConName = tcQual gHC_GENERICS (fsLit "Rep") repTyConKey -rep1TyConName = tcQual gHC_GENERICS (fsLit "Rep1") rep1TyConKey - -uRecTyConName = tcQual gHC_GENERICS (fsLit "URec") uRecTyConKey -uAddrTyConName = tcQual gHC_GENERICS (fsLit "UAddr") uAddrTyConKey -uCharTyConName = tcQual gHC_GENERICS (fsLit "UChar") uCharTyConKey -uDoubleTyConName = tcQual gHC_GENERICS (fsLit "UDouble") uDoubleTyConKey -uFloatTyConName = tcQual gHC_GENERICS (fsLit "UFloat") uFloatTyConKey -uIntTyConName = tcQual gHC_GENERICS (fsLit "UInt") uIntTyConKey -uWordTyConName = tcQual gHC_GENERICS (fsLit "UWord") uWordTyConKey - -prefixIDataConName = dcQual gHC_GENERICS (fsLit "PrefixI") prefixIDataConKey -infixIDataConName = dcQual gHC_GENERICS (fsLit "InfixI") infixIDataConKey -leftAssociativeDataConName = dcQual gHC_GENERICS (fsLit "LeftAssociative") leftAssociativeDataConKey -rightAssociativeDataConName = dcQual gHC_GENERICS (fsLit "RightAssociative") rightAssociativeDataConKey -notAssociativeDataConName = dcQual gHC_GENERICS (fsLit "NotAssociative") notAssociativeDataConKey - -sourceUnpackDataConName = dcQual gHC_GENERICS (fsLit "SourceUnpack") sourceUnpackDataConKey -sourceNoUnpackDataConName = dcQual gHC_GENERICS (fsLit "SourceNoUnpack") sourceNoUnpackDataConKey -noSourceUnpackednessDataConName = dcQual gHC_GENERICS (fsLit "NoSourceUnpackedness") noSourceUnpackednessDataConKey -sourceLazyDataConName = dcQual gHC_GENERICS (fsLit "SourceLazy") sourceLazyDataConKey -sourceStrictDataConName = dcQual gHC_GENERICS (fsLit "SourceStrict") sourceStrictDataConKey -noSourceStrictnessDataConName = dcQual gHC_GENERICS (fsLit "NoSourceStrictness") noSourceStrictnessDataConKey -decidedLazyDataConName = dcQual gHC_GENERICS (fsLit "DecidedLazy") decidedLazyDataConKey -decidedStrictDataConName = dcQual gHC_GENERICS (fsLit "DecidedStrict") decidedStrictDataConKey -decidedUnpackDataConName = dcQual gHC_GENERICS (fsLit "DecidedUnpack") decidedUnpackDataConKey - -metaDataDataConName = dcQual gHC_GENERICS (fsLit "MetaData") metaDataDataConKey -metaConsDataConName = dcQual gHC_GENERICS (fsLit "MetaCons") metaConsDataConKey -metaSelDataConName = dcQual gHC_GENERICS (fsLit "MetaSel") metaSelDataConKey + metaDataDataConName, metaConsDataConName, metaSelDataConName :: WiredIn Name + +v1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "V1") <*> pure v1TyConKey +u1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "U1") <*> pure u1TyConKey +par1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "Par1") <*> pure par1TyConKey +rec1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "Rec1") <*> pure rec1TyConKey +k1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "K1") <*> pure k1TyConKey +m1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "M1") <*> pure m1TyConKey + +sumTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit ":+:") <*> pure sumTyConKey +prodTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit ":*:") <*> pure prodTyConKey +compTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit ":.:") <*> pure compTyConKey + +rTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "R") <*> pure rTyConKey +dTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "D") <*> pure dTyConKey +cTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "C") <*> pure cTyConKey +sTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "S") <*> pure sTyConKey + +rec0TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "Rec0") <*> pure rec0TyConKey +d1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "D1") <*> pure d1TyConKey +c1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "C1") <*> pure c1TyConKey +s1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "S1") <*> pure s1TyConKey + +repTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "Rep") <*> pure repTyConKey +rep1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "Rep1") <*> pure rep1TyConKey + +uRecTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "URec") <*> pure uRecTyConKey +uAddrTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "UAddr") <*> pure uAddrTyConKey +uCharTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "UChar") <*> pure uCharTyConKey +uDoubleTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "UDouble") <*> pure uDoubleTyConKey +uFloatTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "UFloat") <*> pure uFloatTyConKey +uIntTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "UInt") <*> pure uIntTyConKey +uWordTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "UWord") <*> pure uWordTyConKey + +prefixIDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "PrefixI") <*> pure prefixIDataConKey +infixIDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "InfixI") <*> pure infixIDataConKey +leftAssociativeDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "LeftAssociative") <*> pure leftAssociativeDataConKey +rightAssociativeDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "RightAssociative") <*> pure rightAssociativeDataConKey +notAssociativeDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "NotAssociative") <*> pure notAssociativeDataConKey + +sourceUnpackDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "SourceUnpack") <*> pure sourceUnpackDataConKey +sourceNoUnpackDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "SourceNoUnpack") <*> pure sourceNoUnpackDataConKey +noSourceUnpackednessDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "NoSourceUnpackedness") <*> pure noSourceUnpackednessDataConKey +sourceLazyDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "SourceLazy") <*> pure sourceLazyDataConKey +sourceStrictDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "SourceStrict") <*> pure sourceStrictDataConKey +noSourceStrictnessDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "NoSourceStrictness") <*> pure noSourceStrictnessDataConKey +decidedLazyDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "DecidedLazy") <*> pure decidedLazyDataConKey +decidedStrictDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "DecidedStrict") <*> pure decidedStrictDataConKey +decidedUnpackDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "DecidedUnpack") <*> pure decidedUnpackDataConKey + +metaDataDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "MetaData") <*> pure metaDataDataConKey +metaConsDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "MetaCons") <*> pure metaConsDataConKey +metaSelDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "MetaSel") <*> pure metaSelDataConKey -- Primitive Int -divIntName, modIntName :: Name -divIntName = varQual gHC_CLASSES (fsLit "divInt#") divIntIdKey -modIntName = varQual gHC_CLASSES (fsLit "modInt#") modIntIdKey +divIntName, modIntName :: WiredIn Name +divIntName = varQual <$> gHC_CLASSES <*> pure (fsLit "divInt#") <*> pure divIntIdKey +modIntName = varQual <$> gHC_CLASSES <*> pure (fsLit "modInt#") <*> pure modIntIdKey -- Base strings Strings unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name, unpackCStringFoldrUtf8Name, unpackCStringAppendName, unpackCStringAppendUtf8Name, - eqStringName, cstringLengthName :: Name -cstringLengthName = varQual gHC_CSTRING (fsLit "cstringLength#") cstringLengthIdKey -eqStringName = varQual gHC_BASE (fsLit "eqString") eqStringIdKey + eqStringName, cstringLengthName :: WiredIn Name +cstringLengthName = varQual <$> gHC_CSTRING <*> pure (fsLit "cstringLength#") <*> pure cstringLengthIdKey +eqStringName = varQual <$> gHC_BASE <*> pure (fsLit "eqString") <*> pure eqStringIdKey -unpackCStringName = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey -unpackCStringAppendName = varQual gHC_CSTRING (fsLit "unpackAppendCString#") unpackCStringAppendIdKey -unpackCStringFoldrName = varQual gHC_CSTRING (fsLit "unpackFoldrCString#") unpackCStringFoldrIdKey +unpackCStringName = varQual <$> gHC_CSTRING <*> pure (fsLit "unpackCString#") <*> pure unpackCStringIdKey +unpackCStringAppendName = varQual <$> gHC_CSTRING <*> pure (fsLit "unpackAppendCString#") <*> pure unpackCStringAppendIdKey +unpackCStringFoldrName = varQual <$> gHC_CSTRING <*> pure (fsLit "unpackFoldrCString#") <*> pure unpackCStringFoldrIdKey -unpackCStringUtf8Name = varQual gHC_CSTRING (fsLit "unpackCStringUtf8#") unpackCStringUtf8IdKey -unpackCStringAppendUtf8Name = varQual gHC_CSTRING (fsLit "unpackAppendCStringUtf8#") unpackCStringAppendUtf8IdKey -unpackCStringFoldrUtf8Name = varQual gHC_CSTRING (fsLit "unpackFoldrCStringUtf8#") unpackCStringFoldrUtf8IdKey +unpackCStringUtf8Name = varQual <$> gHC_CSTRING <*> pure (fsLit "unpackCStringUtf8#") <*> pure unpackCStringUtf8IdKey +unpackCStringAppendUtf8Name = varQual <$> gHC_CSTRING <*> pure (fsLit "unpackAppendCStringUtf8#") <*> pure unpackCStringAppendUtf8IdKey +unpackCStringFoldrUtf8Name = varQual <$> gHC_CSTRING <*> pure (fsLit "unpackFoldrCStringUtf8#") <*> pure unpackCStringFoldrUtf8IdKey -- The 'inline' function -inlineIdName :: Name -inlineIdName = varQual gHC_MAGIC (fsLit "inline") inlineIdKey +inlineIdName :: WiredIn Name +inlineIdName = varQual <$> gHC_MAGIC <*> pure (fsLit "inline") <*> pure inlineIdKey -- Base classes (Eq, Ord, Functor) -fmapName, eqClassName, eqName, ordClassName, geName, functorClassName :: Name -eqClassName = clsQual gHC_CLASSES (fsLit "Eq") eqClassKey -eqName = varQual gHC_CLASSES (fsLit "==") eqClassOpKey -ordClassName = clsQual gHC_CLASSES (fsLit "Ord") ordClassKey -geName = varQual gHC_CLASSES (fsLit ">=") geClassOpKey -functorClassName = clsQual gHC_BASE (fsLit "Functor") functorClassKey -fmapName = varQual gHC_BASE (fsLit "fmap") fmapClassOpKey +fmapName, eqClassName, eqName, ordClassName, geName, functorClassName :: WiredIn Name +eqClassName = clsQual <$> gHC_CLASSES <*> pure (fsLit "Eq") <*> pure eqClassKey +eqName = varQual <$> gHC_CLASSES <*> pure (fsLit "==") <*> pure eqClassOpKey +ordClassName = clsQual <$> gHC_CLASSES <*> pure (fsLit "Ord") <*> pure ordClassKey +geName = varQual <$> gHC_CLASSES <*> pure (fsLit ">=") <*> pure geClassOpKey +functorClassName = clsQual <$> gHC_BASE <*> pure (fsLit "Functor") <*> pure functorClassKey +fmapName = varQual <$> gHC_BASE <*> pure (fsLit "fmap") <*> pure fmapClassOpKey -- Class Monad -monadClassName, thenMName, bindMName, returnMName :: Name -monadClassName = clsQual gHC_BASE (fsLit "Monad") monadClassKey -thenMName = varQual gHC_BASE (fsLit ">>") thenMClassOpKey -bindMName = varQual gHC_BASE (fsLit ">>=") bindMClassOpKey -returnMName = varQual gHC_BASE (fsLit "return") returnMClassOpKey +monadClassName, thenMName, bindMName, returnMName :: WiredIn Name +monadClassName = clsQual <$> gHC_BASE <*> pure (fsLit "Monad") <*> pure monadClassKey +thenMName = varQual <$> gHC_BASE <*> pure (fsLit ">>") <*> pure thenMClassOpKey +bindMName = varQual <$> gHC_BASE <*> pure (fsLit ">>=") <*> pure bindMClassOpKey +returnMName = varQual <$> gHC_BASE <*> pure (fsLit "return") <*> pure returnMClassOpKey -- Class MonadFail -monadFailClassName, failMName :: Name -monadFailClassName = clsQual mONAD_FAIL (fsLit "MonadFail") monadFailClassKey -failMName = varQual mONAD_FAIL (fsLit "fail") failMClassOpKey +monadFailClassName, failMName :: WiredIn Name +monadFailClassName = clsQual <$> mONAD_FAIL <*> pure (fsLit "MonadFail") <*> pure monadFailClassKey +failMName = varQual <$> mONAD_FAIL <*> pure (fsLit "fail") <*> pure failMClassOpKey -- Class Applicative -applicativeClassName, pureAName, apAName, thenAName :: Name -applicativeClassName = clsQual gHC_BASE (fsLit "Applicative") applicativeClassKey -apAName = varQual gHC_BASE (fsLit "<*>") apAClassOpKey -pureAName = varQual gHC_BASE (fsLit "pure") pureAClassOpKey -thenAName = varQual gHC_BASE (fsLit "*>") thenAClassOpKey +applicativeClassName, pureAName, apAName, thenAName :: WiredIn Name +applicativeClassName = clsQual <$> gHC_BASE <*> pure (fsLit "Applicative") <*> pure applicativeClassKey +apAName = varQual <$> gHC_BASE <*> pure (fsLit "<*>") <*> pure apAClassOpKey +pureAName = varQual <$> gHC_BASE <*> pure (fsLit "pure") <*> pure pureAClassOpKey +thenAName = varQual <$> gHC_BASE <*> pure (fsLit "*>") <*> pure thenAClassOpKey -- Classes (Foldable, Traversable) -foldableClassName, traversableClassName :: Name -foldableClassName = clsQual dATA_FOLDABLE (fsLit "Foldable") foldableClassKey -traversableClassName = clsQual dATA_TRAVERSABLE (fsLit "Traversable") traversableClassKey +foldableClassName, traversableClassName :: WiredIn Name +foldableClassName = clsQual <$> dATA_FOLDABLE <*> pure (fsLit "Foldable") <*> pure foldableClassKey +traversableClassName = clsQual <$> dATA_TRAVERSABLE <*> pure (fsLit "Traversable") <*> pure traversableClassKey -- Classes (Semigroup, Monoid) -semigroupClassName, sappendName :: Name -semigroupClassName = clsQual gHC_BASE (fsLit "Semigroup") semigroupClassKey -sappendName = varQual gHC_BASE (fsLit "<>") sappendClassOpKey -monoidClassName, memptyName, mappendName, mconcatName :: Name -monoidClassName = clsQual gHC_BASE (fsLit "Monoid") monoidClassKey -memptyName = varQual gHC_BASE (fsLit "mempty") memptyClassOpKey -mappendName = varQual gHC_BASE (fsLit "mappend") mappendClassOpKey -mconcatName = varQual gHC_BASE (fsLit "mconcat") mconcatClassOpKey +semigroupClassName, sappendName :: WiredIn Name +semigroupClassName = clsQual <$> gHC_BASE <*> pure (fsLit "Semigroup") <*> pure semigroupClassKey +sappendName = varQual <$> gHC_BASE <*> pure (fsLit "<>") <*> pure sappendClassOpKey +monoidClassName, memptyName, mappendName, mconcatName :: WiredIn Name +monoidClassName = clsQual <$> gHC_BASE <*> pure (fsLit "Monoid") <*> pure monoidClassKey +memptyName = varQual <$> gHC_BASE <*> pure (fsLit "mempty") <*> pure memptyClassOpKey +mappendName = varQual <$> gHC_BASE <*> pure (fsLit "mappend") <*> pure mappendClassOpKey +mconcatName = varQual <$> gHC_BASE <*> pure (fsLit "mconcat") <*> pure mconcatClassOpKey -- AMP additions -joinMName, alternativeClassName :: Name -joinMName = varQual gHC_BASE (fsLit "join") joinMIdKey -alternativeClassName = clsQual mONAD (fsLit "Alternative") alternativeClassKey +joinMName, alternativeClassName :: WiredIn Name +joinMName = varQual <$> gHC_BASE <*> pure (fsLit "join") <*> pure joinMIdKey +alternativeClassName = clsQual <$> mONAD <*> pure (fsLit "Alternative") <*> pure alternativeClassKey -- joinMIdKey, apAClassOpKey, pureAClassOpKey, thenAClassOpKey, @@ -1124,29 +1127,29 @@ alternativeClassKey = mkPreludeMiscIdUnique 754 -- Functions for GHC extensions -considerAccessibleName :: Name -considerAccessibleName = varQual gHC_EXTS (fsLit "considerAccessible") considerAccessibleIdKey +considerAccessibleName :: WiredIn Name +considerAccessibleName = varQual <$> gHC_EXTS <*> pure (fsLit "considerAccessible") <*> pure considerAccessibleIdKey -- Random GHC.Base functions fromStringName, otherwiseIdName, foldrName, buildName, augmentName, mapName, appendName, assertName, - dollarName :: Name -dollarName = varQual gHC_BASE (fsLit "$") dollarIdKey -otherwiseIdName = varQual gHC_BASE (fsLit "otherwise") otherwiseIdKey -foldrName = varQual gHC_BASE (fsLit "foldr") foldrIdKey -buildName = varQual gHC_BASE (fsLit "build") buildIdKey -augmentName = varQual gHC_BASE (fsLit "augment") augmentIdKey -mapName = varQual gHC_BASE (fsLit "map") mapIdKey -appendName = varQual gHC_BASE (fsLit "++") appendIdKey -assertName = varQual gHC_BASE (fsLit "assert") assertIdKey -fromStringName = varQual dATA_STRING (fsLit "fromString") fromStringClassOpKey + dollarName :: WiredIn Name +dollarName = varQual <$> gHC_BASE <*> pure (fsLit "$") <*> pure dollarIdKey +otherwiseIdName = varQual <$> gHC_BASE <*> pure (fsLit "otherwise") <*> pure otherwiseIdKey +foldrName = varQual <$> gHC_BASE <*> pure (fsLit "foldr") <*> pure foldrIdKey +buildName = varQual <$> gHC_BASE <*> pure (fsLit "build") <*> pure buildIdKey +augmentName = varQual <$> gHC_BASE <*> pure (fsLit "augment") <*> pure augmentIdKey +mapName = varQual <$> gHC_BASE <*> pure (fsLit "map") <*> pure mapIdKey +appendName = varQual <$> gHC_BASE <*> pure (fsLit "++") <*> pure appendIdKey +assertName = varQual <$> gHC_BASE <*> pure (fsLit "assert") <*> pure assertIdKey +fromStringName = varQual <$> dATA_STRING <*> pure (fsLit "fromString") <*> pure fromStringClassOpKey -- Module GHC.Num -numClassName, fromIntegerName, minusName, negateName :: Name -numClassName = clsQual gHC_NUM (fsLit "Num") numClassKey -fromIntegerName = varQual gHC_NUM (fsLit "fromInteger") fromIntegerClassOpKey -minusName = varQual gHC_NUM (fsLit "-") minusClassOpKey -negateName = varQual gHC_NUM (fsLit "negate") negateClassOpKey +numClassName, fromIntegerName, minusName, negateName :: WiredIn Name +numClassName = clsQual <$> gHC_NUM <*> pure (fsLit "Num") <*> pure numClassKey +fromIntegerName = varQual <$> gHC_NUM <*> pure (fsLit "fromInteger") <*> pure fromIntegerClassOpKey +minusName = varQual <$> gHC_NUM <*> pure (fsLit "-") <*> pure minusClassOpKey +negateName = varQual <$> gHC_NUM <*> pure (fsLit "negate") <*> pure negateClassOpKey --------------------------------- -- ghc-bignum @@ -1215,12 +1218,12 @@ integerFromNaturalName , bignatEqName , bignatCompareName , bignatCompareWordName - :: Name + :: WiredIn Name -bnbVarQual, bnnVarQual, bniVarQual :: String -> Unique -> Name -bnbVarQual str key = varQual gHC_NUM_BIGNAT (fsLit str) key -bnnVarQual str key = varQual gHC_NUM_NATURAL (fsLit str) key -bniVarQual str key = varQual gHC_NUM_INTEGER (fsLit str) key +bnbVarQual, bnnVarQual, bniVarQual :: String -> Unique -> WiredIn Name +bnbVarQual str key = varQual <$> gHC_NUM_BIGNAT <*> pure (fsLit str) key +bnnVarQual str key = varQual <$> gHC_NUM_NATURAL <*> pure (fsLit str) <*> pure key +bniVarQual str key = varQual <$> gHC_NUM_INTEGER <*> pure (fsLit str) <*> pure key -- Types and DataCons bignatFromWordListName = bnbVarQual "bigNatFromWordList#" bignatFromWordListIdKey @@ -1300,40 +1303,40 @@ integerShiftRName = bniVarQual "integerShiftR#" integerShiftR rationalTyConName, ratioTyConName, ratioDataConName, realClassName, integralClassName, realFracClassName, fractionalClassName, fromRationalName, toIntegerName, toRationalName, fromIntegralName, - realToFracName, mkRationalBase2Name, mkRationalBase10Name :: Name -rationalTyConName = tcQual gHC_REAL (fsLit "Rational") rationalTyConKey -ratioTyConName = tcQual gHC_REAL (fsLit "Ratio") ratioTyConKey -ratioDataConName = dcQual gHC_REAL (fsLit ":%") ratioDataConKey -realClassName = clsQual gHC_REAL (fsLit "Real") realClassKey -integralClassName = clsQual gHC_REAL (fsLit "Integral") integralClassKey -realFracClassName = clsQual gHC_REAL (fsLit "RealFrac") realFracClassKey -fractionalClassName = clsQual gHC_REAL (fsLit "Fractional") fractionalClassKey -fromRationalName = varQual gHC_REAL (fsLit "fromRational") fromRationalClassOpKey -toIntegerName = varQual gHC_REAL (fsLit "toInteger") toIntegerClassOpKey -toRationalName = varQual gHC_REAL (fsLit "toRational") toRationalClassOpKey -fromIntegralName = varQual gHC_REAL (fsLit "fromIntegral")fromIntegralIdKey -realToFracName = varQual gHC_REAL (fsLit "realToFrac") realToFracIdKey -mkRationalBase2Name = varQual gHC_REAL (fsLit "mkRationalBase2") mkRationalBase2IdKey -mkRationalBase10Name = varQual gHC_REAL (fsLit "mkRationalBase10") mkRationalBase10IdKey + realToFracName, mkRationalBase2Name, mkRationalBase10Name :: WiredIn Name +rationalTyConName = tcQual <$> gHC_REAL <*> pure (fsLit "Rational") <*> pure rationalTyConKey +ratioTyConName = tcQual <$> gHC_REAL <*> pure (fsLit "Ratio") <*> pure ratioTyConKey +ratioDataConName = dcQual <$> gHC_REAL <*> pure (fsLit ":%") <*> pure ratioDataConKey +realClassName = clsQual <$> gHC_REAL <*> pure (fsLit "Real") <*> pure realClassKey +integralClassName = clsQual <$> gHC_REAL <*> pure (fsLit "Integral") <*> pure integralClassKey +realFracClassName = clsQual <$> gHC_REAL <*> pure (fsLit "RealFrac") <*> pure realFracClassKey +fractionalClassName = clsQual <$> gHC_REAL <*> pure (fsLit "Fractional") <*> pure fractionalClassKey +fromRationalName = varQual <$> gHC_REAL <*> pure (fsLit "fromRational") <*> pure fromRationalClassOpKey +toIntegerName = varQual <$> gHC_REAL <*> pure (fsLit "toInteger") <*> pure toIntegerClassOpKey +toRationalName = varQual <$> gHC_REAL <*> pure (fsLit "toRational") <*> pure toRationalClassOpKey +fromIntegralName = varQual <$> gHC_REAL <*> pure (fsLit "fromIntegral") <*> pure fromIntegralIdKey +realToFracName = varQual <$> gHC_REAL <*> pure (fsLit "realToFrac") <*> pure realToFracIdKey +mkRationalBase2Name = varQual <$> gHC_REAL <*> pure (fsLit "mkRationalBase2") <*> pure mkRationalBase2IdKey +mkRationalBase10Name = varQual <$> gHC_REAL <*> pure (fsLit "mkRationalBase10") <*> pure mkRationalBase10IdKey -- GHC.Float classes -floatingClassName, realFloatClassName :: Name -floatingClassName = clsQual gHC_FLOAT (fsLit "Floating") floatingClassKey -realFloatClassName = clsQual gHC_FLOAT (fsLit "RealFloat") realFloatClassKey +floatingClassName, realFloatClassName :: WiredIn Name +floatingClassName = clsQual <$> gHC_FLOAT <*> pure (fsLit "Floating") <*> pure floatingClassKey +realFloatClassName = clsQual <$> gHC_FLOAT <*> pure (fsLit "RealFloat") <*> pure realFloatClassKey -- other GHC.Float functions integerToFloatName, integerToDoubleName, naturalToFloatName, naturalToDoubleName, - rationalToFloatName, rationalToDoubleName :: Name -integerToFloatName = varQual gHC_FLOAT (fsLit "integerToFloat#") integerToFloatIdKey -integerToDoubleName = varQual gHC_FLOAT (fsLit "integerToDouble#") integerToDoubleIdKey -naturalToFloatName = varQual gHC_FLOAT (fsLit "naturalToFloat#") naturalToFloatIdKey -naturalToDoubleName = varQual gHC_FLOAT (fsLit "naturalToDouble#") naturalToDoubleIdKey -rationalToFloatName = varQual gHC_FLOAT (fsLit "rationalToFloat") rationalToFloatIdKey -rationalToDoubleName = varQual gHC_FLOAT (fsLit "rationalToDouble") rationalToDoubleIdKey + rationalToFloatName, rationalToDoubleName :: WiredIn Name +integerToFloatName = varQual <$> gHC_FLOAT <*> pure (fsLit "integerToFloat#") <*> pure integerToFloatIdKey +integerToDoubleName = varQual <$> gHC_FLOAT <*> pure (fsLit "integerToDouble#") <*> pure integerToDoubleIdKey +naturalToFloatName = varQual <$> gHC_FLOAT <*> pure (fsLit "naturalToFloat#") <*> pure naturalToFloatIdKey +naturalToDoubleName = varQual <$> gHC_FLOAT <*> pure (fsLit "naturalToDouble#") <*> pure naturalToDoubleIdKey +rationalToFloatName = varQual <$> gHC_FLOAT <*> pure (fsLit "rationalToFloat") <*> pure rationalToFloatIdKey +rationalToDoubleName = varQual <$> gHC_FLOAT <*> pure (fsLit "rationalToDouble") <*> pure rationalToDoubleIdKey -- Class Ix -ixClassName :: Name -ixClassName = clsQual gHC_IX (fsLit "Ix") ixClassKey +ixClassName :: WiredIn Name +ixClassName = clsQual <$> gHC_IX <*> pure (fsLit "Ix") <*> pure ixClassKey -- Typeable representation types trModuleTyConName @@ -1343,14 +1346,14 @@ trModuleTyConName , trNameDDataConName , trTyConTyConName , trTyConDataConName - :: Name -trModuleTyConName = tcQual gHC_TYPES (fsLit "Module") trModuleTyConKey -trModuleDataConName = dcQual gHC_TYPES (fsLit "Module") trModuleDataConKey -trNameTyConName = tcQual gHC_TYPES (fsLit "TrName") trNameTyConKey -trNameSDataConName = dcQual gHC_TYPES (fsLit "TrNameS") trNameSDataConKey -trNameDDataConName = dcQual gHC_TYPES (fsLit "TrNameD") trNameDDataConKey -trTyConTyConName = tcQual gHC_TYPES (fsLit "TyCon") trTyConTyConKey -trTyConDataConName = dcQual gHC_TYPES (fsLit "TyCon") trTyConDataConKey + :: WiredIn Name +trModuleTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "Module") <*> pure trModuleTyConKey +trModuleDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "Module") <*> pure trModuleDataConKey +trNameTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "TrName") <*> pure trNameTyConKey +trNameSDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "TrNameS") <*> pure trNameSDataConKey +trNameDDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "TrNameD") <*> pure trNameDDataConKey +trTyConTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "TyCon") <*> pure trTyConTyConKey +trTyConDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "TyCon") <*> pure trTyConDataConKey kindRepTyConName , kindRepTyConAppDataConName @@ -1360,25 +1363,25 @@ kindRepTyConName , kindRepTYPEDataConName , kindRepTypeLitSDataConName , kindRepTypeLitDDataConName - :: Name -kindRepTyConName = tcQual gHC_TYPES (fsLit "KindRep") kindRepTyConKey -kindRepTyConAppDataConName = dcQual gHC_TYPES (fsLit "KindRepTyConApp") kindRepTyConAppDataConKey -kindRepVarDataConName = dcQual gHC_TYPES (fsLit "KindRepVar") kindRepVarDataConKey -kindRepAppDataConName = dcQual gHC_TYPES (fsLit "KindRepApp") kindRepAppDataConKey -kindRepFunDataConName = dcQual gHC_TYPES (fsLit "KindRepFun") kindRepFunDataConKey -kindRepTYPEDataConName = dcQual gHC_TYPES (fsLit "KindRepTYPE") kindRepTYPEDataConKey -kindRepTypeLitSDataConName = dcQual gHC_TYPES (fsLit "KindRepTypeLitS") kindRepTypeLitSDataConKey -kindRepTypeLitDDataConName = dcQual gHC_TYPES (fsLit "KindRepTypeLitD") kindRepTypeLitDDataConKey + :: WiredIn Name +kindRepTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "KindRep") <*> pure kindRepTyConKey +kindRepTyConAppDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepTyConApp") <*> pure kindRepTyConAppDataConKey +kindRepVarDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepVar") <*> pure kindRepVarDataConKey +kindRepAppDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepApp") <*> pure kindRepAppDataConKey +kindRepFunDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepFun") <*> pure kindRepFunDataConKey +kindRepTYPEDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepTYPE") <*> pure kindRepTYPEDataConKey +kindRepTypeLitSDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepTypeLitS") <*> pure kindRepTypeLitSDataConKey +kindRepTypeLitDDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepTypeLitD") <*> pure kindRepTypeLitDDataConKey typeLitSortTyConName , typeLitSymbolDataConName , typeLitNatDataConName , typeLitCharDataConName - :: Name -typeLitSortTyConName = tcQual gHC_TYPES (fsLit "TypeLitSort") typeLitSortTyConKey -typeLitSymbolDataConName = dcQual gHC_TYPES (fsLit "TypeLitSymbol") typeLitSymbolDataConKey -typeLitNatDataConName = dcQual gHC_TYPES (fsLit "TypeLitNat") typeLitNatDataConKey -typeLitCharDataConName = dcQual gHC_TYPES (fsLit "TypeLitChar") typeLitCharDataConKey + :: WiredIn Name +typeLitSortTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "TypeLitSort") <*> pure typeLitSortTyConKey +typeLitSymbolDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "TypeLitSymbol") <*> pure typeLitSymbolDataConKey +typeLitNatDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "TypeLitNat") <*> pure typeLitNatDataConKey +typeLitCharDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "TypeLitChar") <*> pure typeLitCharDataConKey -- Class Typeable, and functions for constructing `Typeable` dictionaries typeableClassName @@ -1394,37 +1397,37 @@ typeableClassName , typeSymbolTypeRepName , typeCharTypeRepName , trGhcPrimModuleName - :: Name -typeableClassName = clsQual tYPEABLE_INTERNAL (fsLit "Typeable") typeableClassKey -typeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "TypeRep") typeRepTyConKey -someTypeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepTyConKey -someTypeRepDataConName = dcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepDataConKey -typeRepIdName = varQual tYPEABLE_INTERNAL (fsLit "typeRep#") typeRepIdKey -mkTrTypeName = varQual tYPEABLE_INTERNAL (fsLit "mkTrType") mkTrTypeKey -mkTrConName = varQual tYPEABLE_INTERNAL (fsLit "mkTrCon") mkTrConKey -mkTrAppName = varQual tYPEABLE_INTERNAL (fsLit "mkTrApp") mkTrAppKey -mkTrFunName = varQual tYPEABLE_INTERNAL (fsLit "mkTrFun") mkTrFunKey -typeNatTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey -typeSymbolTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey -typeCharTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeCharTypeRep") typeCharTypeRepKey + :: WiredIn Name +typeableClassName = clsQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "Typeable") <*> pure typeableClassKey +typeRepTyConName = tcQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "TypeRep") <*> pure typeRepTyConKey +someTypeRepTyConName = tcQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "SomeTypeRep") <*> pure someTypeRepTyConKey +someTypeRepDataConName = dcQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "SomeTypeRep") <*> pure someTypeRepDataConKey +typeRepIdName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "typeRep#") <*> pure typeRepIdKey +mkTrTypeName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "mkTrType") <*> pure mkTrTypeKey +mkTrConName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "mkTrCon") <*> pure mkTrConKey +mkTrAppName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "mkTrApp") <*> pure mkTrAppKey +mkTrFunName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "mkTrFun") <*> pure mkTrFunKey +typeNatTypeRepName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "typeNatTypeRep") <*> pure typeNatTypeRepKey +typeSymbolTypeRepName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "typeSymbolTypeRep") <*> pure typeSymbolTypeRepKey +typeCharTypeRepName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "typeCharTypeRep") <*> pure typeCharTypeRepKey -- this is the Typeable 'Module' for GHC.Prim (which has no code, so we place in GHC.Types) -- See Note [Grand plan for Typeable] in GHC.Tc.Instance.Typeable. -trGhcPrimModuleName = varQual gHC_TYPES (fsLit "tr$ModuleGHCPrim") trGhcPrimModuleKey +trGhcPrimModuleName = varQual <$> gHC_TYPES <*> pure (fsLit "tr$ModuleGHCPrim") <*> pure trGhcPrimModuleKey -- Typeable KindReps for some common cases starKindRepName, starArrStarKindRepName, - starArrStarArrStarKindRepName, constraintKindRepName :: Name -starKindRepName = varQual gHC_TYPES (fsLit "krep$*") starKindRepKey -starArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*Arr*") starArrStarKindRepKey -starArrStarArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*->*->*") starArrStarArrStarKindRepKey -constraintKindRepName = varQual gHC_TYPES (fsLit "krep$Constraint") constraintKindRepKey + starArrStarArrStarKindRepName, constraintKindRepName :: WiredIn Name +starKindRepName = varQual <$> gHC_TYPES <*> pure (fsLit "krep$*") <*> pure starKindRepKey +starArrStarKindRepName = varQual <$> gHC_TYPES <*> pure (fsLit "krep$*Arr*") <*> pure starArrStarKindRepKey +starArrStarArrStarKindRepName = varQual <$> gHC_TYPES <*> pure (fsLit "krep$*->*->*") <*> pure starArrStarArrStarKindRepKey +constraintKindRepName = varQual <$> gHC_TYPES <*> pure (fsLit "krep$Constraint") <*> pure constraintKindRepKey -- WithDict -withDictClassName :: Name -withDictClassName = clsQual gHC_MAGIC_DICT (fsLit "WithDict") withDictClassKey +withDictClassName :: WiredIn Name +withDictClassName = clsQual <$> gHC_MAGIC_DICT <*> pure (fsLit "WithDict") <*> pure withDictClassKey -nonEmptyTyConName :: Name -nonEmptyTyConName = tcQual gHC_BASE (fsLit "NonEmpty") nonEmptyTyConKey +nonEmptyTyConName :: WiredIn Name +nonEmptyTyConName = tcQual <$> gHC_BASE <*> pure (fsLit "NonEmpty") <*> pure nonEmptyTyConKey -- Custom type errors errorMessageTypeErrorFamName @@ -1432,244 +1435,244 @@ errorMessageTypeErrorFamName , typeErrorAppendDataConName , typeErrorVAppendDataConName , typeErrorShowTypeDataConName - :: Name + :: WiredIn Name errorMessageTypeErrorFamName = - tcQual gHC_TYPEERROR (fsLit "TypeError") errorMessageTypeErrorFamKey + tcQual <$> gHC_TYPEERROR <*> pure (fsLit "TypeError") <*> pure errorMessageTypeErrorFamKey typeErrorTextDataConName = - dcQual gHC_TYPEERROR (fsLit "Text") typeErrorTextDataConKey + dcQual <$> gHC_TYPEERROR <*> pure (fsLit "Text") <*> pure typeErrorTextDataConKey typeErrorAppendDataConName = - dcQual gHC_TYPEERROR (fsLit ":<>:") typeErrorAppendDataConKey + dcQual <$> gHC_TYPEERROR <*> pure (fsLit ":<>:") <*> pure typeErrorAppendDataConKey typeErrorVAppendDataConName = - dcQual gHC_TYPEERROR (fsLit ":$$:") typeErrorVAppendDataConKey + dcQual <$> gHC_TYPEERROR <*> pure (fsLit ":$$:") <*> pure typeErrorVAppendDataConKey typeErrorShowTypeDataConName = - dcQual gHC_TYPEERROR (fsLit "ShowType") typeErrorShowTypeDataConKey + dcQual <$> gHC_TYPEERROR <*> pure (fsLit "ShowType") <*> pure typeErrorShowTypeDataConKey -- Unsafe coercion proofs unsafeEqualityProofName, unsafeEqualityTyConName, unsafeCoercePrimName, - unsafeReflDataConName :: Name -unsafeEqualityProofName = varQual uNSAFE_COERCE (fsLit "unsafeEqualityProof") unsafeEqualityProofIdKey -unsafeEqualityTyConName = tcQual uNSAFE_COERCE (fsLit "UnsafeEquality") unsafeEqualityTyConKey -unsafeReflDataConName = dcQual uNSAFE_COERCE (fsLit "UnsafeRefl") unsafeReflDataConKey -unsafeCoercePrimName = varQual uNSAFE_COERCE (fsLit "unsafeCoerce#") unsafeCoercePrimIdKey + unsafeReflDataConName :: WiredIn Name +unsafeEqualityProofName = varQual <$> uNSAFE_COERCE <*> pure (fsLit "unsafeEqualityProof") <*> pure unsafeEqualityProofIdKey +unsafeEqualityTyConName = tcQual <$> uNSAFE_COERCE <*> pure (fsLit "UnsafeEquality") <*> pure unsafeEqualityTyConKey +unsafeReflDataConName = dcQual <$> uNSAFE_COERCE <*> pure (fsLit "UnsafeRefl") <*> pure unsafeReflDataConKey +unsafeCoercePrimName = varQual <$> uNSAFE_COERCE <*> pure (fsLit "unsafeCoerce#") <*> pure unsafeCoercePrimIdKey -- Dynamic -toDynName :: Name -toDynName = varQual dYNAMIC (fsLit "toDyn") toDynIdKey +toDynName :: WiredIn Name +toDynName = varQual <$> dYNAMIC <*> pure (fsLit "toDyn") <*> pure toDynIdKey -- Class Data -dataClassName :: Name -dataClassName = clsQual gENERICS (fsLit "Data") dataClassKey +dataClassName :: WiredIn Name +dataClassName = clsQual <$> gENERICS <*> pure (fsLit "Data") <*> pure dataClassKey -- Error module -assertErrorName :: Name -assertErrorName = varQual gHC_IO_Exception (fsLit "assertError") assertErrorIdKey +assertErrorName :: WiredIn Name +assertErrorName = varQual <$> gHC_IO_Exception <*> pure (fsLit "assertError") <*> pure assertErrorIdKey -- Debug.Trace -traceName :: Name -traceName = varQual dEBUG_TRACE (fsLit "trace") traceKey +traceName :: WiredIn Name +traceName = varQual <$> dEBUG_TRACE <*> pure (fsLit "trace") <*> pure traceKey -- Enum module (Enum, Bounded) enumClassName, enumFromName, enumFromToName, enumFromThenName, - enumFromThenToName, boundedClassName :: Name -enumClassName = clsQual gHC_ENUM (fsLit "Enum") enumClassKey -enumFromName = varQual gHC_ENUM (fsLit "enumFrom") enumFromClassOpKey -enumFromToName = varQual gHC_ENUM (fsLit "enumFromTo") enumFromToClassOpKey -enumFromThenName = varQual gHC_ENUM (fsLit "enumFromThen") enumFromThenClassOpKey -enumFromThenToName = varQual gHC_ENUM (fsLit "enumFromThenTo") enumFromThenToClassOpKey -boundedClassName = clsQual gHC_ENUM (fsLit "Bounded") boundedClassKey + enumFromThenToName, boundedClassName :: WiredIn Name +enumClassName = clsQual <$> gHC_ENUM <*> pure (fsLit "Enum") <*> pure enumClassKey +enumFromName = varQual <$> gHC_ENUM <*> pure (fsLit "enumFrom") <*> pure enumFromClassOpKey +enumFromToName = varQual <$> gHC_ENUM <*> pure (fsLit "enumFromTo") <*> pure enumFromToClassOpKey +enumFromThenName = varQual <$> gHC_ENUM <*> pure (fsLit "enumFromThen") <*> pure enumFromThenClassOpKey +enumFromThenToName = varQual <$> gHC_ENUM <*> pure (fsLit "enumFromThenTo") <*> pure enumFromThenToClassOpKey +boundedClassName = clsQual <$> gHC_ENUM <*> pure (fsLit "Bounded") <*> pure boundedClassKey -- List functions -concatName, filterName, zipName :: Name -concatName = varQual gHC_LIST (fsLit "concat") concatIdKey -filterName = varQual gHC_LIST (fsLit "filter") filterIdKey -zipName = varQual gHC_LIST (fsLit "zip") zipIdKey +concatName, filterName, zipName :: WiredIn Name +concatName = varQual <$> gHC_LIST <*> pure (fsLit "concat") <*> pure concatIdKey +filterName = varQual <$> gHC_LIST <*> pure (fsLit "filter") <*> pure filterIdKey +zipName = varQual <$> gHC_LIST <*> pure (fsLit "zip") <*> pure zipIdKey -- Overloaded lists -isListClassName, fromListName, fromListNName, toListName :: Name -isListClassName = clsQual gHC_IS_LIST (fsLit "IsList") isListClassKey -fromListName = varQual gHC_IS_LIST (fsLit "fromList") fromListClassOpKey -fromListNName = varQual gHC_IS_LIST (fsLit "fromListN") fromListNClassOpKey -toListName = varQual gHC_IS_LIST (fsLit "toList") toListClassOpKey +isListClassName, fromListName, fromListNName, toListName :: WiredIn Name +isListClassName = clsQual <$> gHC_IS_LIST <*> pure (fsLit "IsList") <*> pure isListClassKey +fromListName = varQual <$> gHC_IS_LIST <*> pure (fsLit "fromList") <*> pure fromListClassOpKey +fromListNName = varQual <$> gHC_IS_LIST <*> pure (fsLit "fromListN") <*> pure fromListNClassOpKey +toListName = varQual <$> gHC_IS_LIST <*> pure (fsLit "toList") <*> pure toListClassOpKey -- HasField class ops -getFieldName, setFieldName :: Name -getFieldName = varQual gHC_RECORDS (fsLit "getField") getFieldClassOpKey -setFieldName = varQual gHC_RECORDS (fsLit "setField") setFieldClassOpKey +getFieldName, setFieldName :: WiredIn Name +getFieldName = varQual <$> gHC_RECORDS <*> pure (fsLit "getField") <*> pure getFieldClassOpKey +setFieldName = varQual <$> gHC_RECORDS <*> pure (fsLit "setField") <*> pure setFieldClassOpKey -- Class Show -showClassName :: Name -showClassName = clsQual gHC_SHOW (fsLit "Show") showClassKey +showClassName :: WiredIn Name +showClassName = clsQual <$> gHC_SHOW <*> pure (fsLit "Show") <*> pure showClassKey -- Class Read -readClassName :: Name -readClassName = clsQual gHC_READ (fsLit "Read") readClassKey +readClassName :: WiredIn Name +readClassName = clsQual <$> gHC_READ <*> pure (fsLit "Read") <*> pure readClassKey -- Classes Generic and Generic1, Datatype, Constructor and Selector genClassName, gen1ClassName, datatypeClassName, constructorClassName, - selectorClassName :: Name -genClassName = clsQual gHC_GENERICS (fsLit "Generic") genClassKey -gen1ClassName = clsQual gHC_GENERICS (fsLit "Generic1") gen1ClassKey + selectorClassName :: WiredIn Name +genClassName = clsQual <$> gHC_GENERICS <*> pure (fsLit "Generic") <*> pure genClassKey +gen1ClassName = clsQual <$> gHC_GENERICS <*> pure (fsLit "Generic1") <*> pure gen1ClassKey -datatypeClassName = clsQual gHC_GENERICS (fsLit "Datatype") datatypeClassKey -constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey -selectorClassName = clsQual gHC_GENERICS (fsLit "Selector") selectorClassKey +datatypeClassName = clsQual <$> gHC_GENERICS <*> pure (fsLit "Datatype") <*> pure datatypeClassKey +constructorClassName = clsQual <$> gHC_GENERICS <*> pure (fsLit "Constructor") <*> pure constructorClassKey +selectorClassName = clsQual <$> gHC_GENERICS <*> pure (fsLit "Selector") <*> pure selectorClassKey -genericClassNames :: [Name] +genericClassNames :: [WiredIn Name] genericClassNames = [genClassName, gen1ClassName] -- GHCi things -ghciIoClassName, ghciStepIoMName :: Name -ghciIoClassName = clsQual gHC_GHCI (fsLit "GHCiSandboxIO") ghciIoClassKey -ghciStepIoMName = varQual gHC_GHCI (fsLit "ghciStepIO") ghciStepIoMClassOpKey +ghciIoClassName, ghciStepIoMName :: WiredIn Name +ghciIoClassName = clsQual <$> gHC_GHCI <*> pure (fsLit "GHCiSandboxIO") <*> pure ghciIoClassKey +ghciStepIoMName = varQual <$> gHC_GHCI <*> pure (fsLit "ghciStepIO") <*> pure ghciStepIoMClassOpKey -- IO things ioTyConName, ioDataConName, - thenIOName, bindIOName, returnIOName, failIOName :: Name -ioTyConName = tcQual gHC_TYPES (fsLit "IO") ioTyConKey -ioDataConName = dcQual gHC_TYPES (fsLit "IO") ioDataConKey -thenIOName = varQual gHC_BASE (fsLit "thenIO") thenIOIdKey -bindIOName = varQual gHC_BASE (fsLit "bindIO") bindIOIdKey -returnIOName = varQual gHC_BASE (fsLit "returnIO") returnIOIdKey -failIOName = varQual gHC_IO (fsLit "failIO") failIOIdKey + thenIOName, bindIOName, returnIOName, failIOName :: WiredIn Name +ioTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "IO") <*> pure ioTyConKey +ioDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "IO") <*> pure ioDataConKey +thenIOName = varQual <$> gHC_BASE <*> pure (fsLit "thenIO") <*> pure thenIOIdKey +bindIOName = varQual <$> gHC_BASE <*> pure (fsLit "bindIO") <*> pure bindIOIdKey +returnIOName = varQual <$> gHC_BASE <*> pure (fsLit "returnIO") <*> pure returnIOIdKey +failIOName = varQual <$> gHC_IO <*> pure (fsLit "failIO") <*> pure failIOIdKey -- IO things -printName :: Name -printName = varQual sYSTEM_IO (fsLit "print") printIdKey +printName :: WiredIn Name +printName = varQual <$> sYSTEM_IO <*> pure (fsLit "print") <*> pure printIdKey -- Int, Word, and Addr things -int8TyConName, int16TyConName, int32TyConName, int64TyConName :: Name -int8TyConName = tcQual gHC_INT (fsLit "Int8") int8TyConKey -int16TyConName = tcQual gHC_INT (fsLit "Int16") int16TyConKey -int32TyConName = tcQual gHC_INT (fsLit "Int32") int32TyConKey -int64TyConName = tcQual gHC_INT (fsLit "Int64") int64TyConKey +int8TyConName, int16TyConName, int32TyConName, int64TyConName :: WiredIn Name +int8TyConName = tcQual <$> gHC_INT <*> pure (fsLit "Int8") <*> pure int8TyConKey +int16TyConName = tcQual <$> gHC_INT <*> pure (fsLit "Int16") <*> pure int16TyConKey +int32TyConName = tcQual <$> gHC_INT <*> pure (fsLit "Int32") <*> pure int32TyConKey +int64TyConName = tcQual <$> gHC_INT <*> pure (fsLit "Int64") <*> pure int64TyConKey -- Word module -word8TyConName, word16TyConName, word32TyConName, word64TyConName :: Name -word8TyConName = tcQual gHC_WORD (fsLit "Word8") word8TyConKey -word16TyConName = tcQual gHC_WORD (fsLit "Word16") word16TyConKey -word32TyConName = tcQual gHC_WORD (fsLit "Word32") word32TyConKey -word64TyConName = tcQual gHC_WORD (fsLit "Word64") word64TyConKey +word8TyConName, word16TyConName, word32TyConName, word64TyConName :: WiredIn Name +word8TyConName = tcQual <$> gHC_WORD <*> pure (fsLit "Word8") <*> pure word8TyConKey +word16TyConName = tcQual <$> gHC_WORD <*> pure (fsLit "Word16") <*> pure word16TyConKey +word32TyConName = tcQual <$> gHC_WORD <*> pure (fsLit "Word32") <*> pure word32TyConKey +word64TyConName = tcQual <$> gHC_WORD <*> pure (fsLit "Word64") <*> pure word64TyConKey -- PrelPtr module -ptrTyConName, funPtrTyConName :: Name -ptrTyConName = tcQual gHC_PTR (fsLit "Ptr") ptrTyConKey -funPtrTyConName = tcQual gHC_PTR (fsLit "FunPtr") funPtrTyConKey +ptrTyConName, funPtrTyConName :: WiredIn Name +ptrTyConName = tcQual <$> gHC_PTR <*> pure (fsLit "Ptr") <*> pure ptrTyConKey +funPtrTyConName = tcQual <$> gHC_PTR <*> pure (fsLit "FunPtr") <*> pure funPtrTyConKey -- Foreign objects and weak pointers -stablePtrTyConName, newStablePtrName :: Name -stablePtrTyConName = tcQual gHC_STABLE (fsLit "StablePtr") stablePtrTyConKey -newStablePtrName = varQual gHC_STABLE (fsLit "newStablePtr") newStablePtrIdKey +stablePtrTyConName, newStablePtrName :: WiredIn Name +stablePtrTyConName = tcQual <$> gHC_STABLE <*> pure (fsLit "StablePtr") <*> pure stablePtrTyConKey +newStablePtrName = varQual <$> gHC_STABLE <*> pure (fsLit "newStablePtr") <*> pure newStablePtrIdKey -- Recursive-do notation -monadFixClassName, mfixName :: Name -monadFixClassName = clsQual mONAD_FIX (fsLit "MonadFix") monadFixClassKey -mfixName = varQual mONAD_FIX (fsLit "mfix") mfixIdKey +monadFixClassName, mfixName :: WiredIn Name +monadFixClassName = clsQual <$> mONAD_FIX <*> pure (fsLit "MonadFix") <*> pure monadFixClassKey +mfixName = varQual <$> mONAD_FIX <*> pure (fsLit "mfix") <*> pure mfixIdKey -- Arrow notation -arrAName, composeAName, firstAName, appAName, choiceAName, loopAName :: Name -arrAName = varQual aRROW (fsLit "arr") arrAIdKey -composeAName = varQual gHC_DESUGAR (fsLit ">>>") composeAIdKey -firstAName = varQual aRROW (fsLit "first") firstAIdKey -appAName = varQual aRROW (fsLit "app") appAIdKey -choiceAName = varQual aRROW (fsLit "|||") choiceAIdKey -loopAName = varQual aRROW (fsLit "loop") loopAIdKey +arrAName, composeAName, firstAName, appAName, choiceAName, loopAName :: WiredIn Name +arrAName = varQual <$> aRROW <*> pure (fsLit "arr") <*> pure arrAIdKey +composeAName = varQual <$> gHC_DESUGAR <*> pure (fsLit ">>>") <*> pure composeAIdKey +firstAName = varQual <$> aRROW <*> pure (fsLit "first") <*> pure firstAIdKey +appAName = varQual <$> aRROW <*> pure (fsLit "app") <*> pure appAIdKey +choiceAName = varQual <$> aRROW <*> pure (fsLit "|||") <*> pure choiceAIdKey +loopAName = varQual <$> aRROW <*> pure (fsLit "loop") <*> pure loopAIdKey -- Monad comprehensions -guardMName, liftMName, mzipName :: Name -guardMName = varQual mONAD (fsLit "guard") guardMIdKey -liftMName = varQual mONAD (fsLit "liftM") liftMIdKey -mzipName = varQual mONAD_ZIP (fsLit "mzip") mzipIdKey +guardMName, liftMName, mzipName :: WiredIn Name +guardMName = varQual <$> mONAD <*> pure (fsLit "guard") <*> pure guardMIdKey +liftMName = varQual <$> mONAD <*> pure (fsLit "liftM") <*> pure liftMIdKey +mzipName = varQual <$> mONAD_ZIP <*> pure (fsLit "mzip") <*> pure mzipIdKey -- Annotation type checking -toAnnotationWrapperName :: Name -toAnnotationWrapperName = varQual gHC_DESUGAR (fsLit "toAnnotationWrapper") toAnnotationWrapperIdKey +toAnnotationWrapperName :: WiredIn Name +toAnnotationWrapperName = varQual <$> gHC_DESUGAR <*> pure (fsLit "toAnnotationWrapper") <*> pure toAnnotationWrapperIdKey -- Other classes, needed for type defaulting -monadPlusClassName, isStringClassName :: Name -monadPlusClassName = clsQual mONAD (fsLit "MonadPlus") monadPlusClassKey -isStringClassName = clsQual dATA_STRING (fsLit "IsString") isStringClassKey +monadPlusClassName, isStringClassName :: WiredIn Name +monadPlusClassName = clsQual <$> mONAD <*> pure (fsLit "MonadPlus") <*> pure monadPlusClassKey +isStringClassName = clsQual <$> dATA_STRING <*> pure (fsLit "IsString") <*> pure isStringClassKey -- Type-level naturals -knownNatClassName :: Name -knownNatClassName = clsQual gHC_TYPENATS (fsLit "KnownNat") knownNatClassNameKey -knownSymbolClassName :: Name -knownSymbolClassName = clsQual gHC_TYPELITS (fsLit "KnownSymbol") knownSymbolClassNameKey -knownCharClassName :: Name -knownCharClassName = clsQual gHC_TYPELITS (fsLit "KnownChar") knownCharClassNameKey +knownNatClassName :: WiredIn Name +knownNatClassName = clsQual <$> gHC_TYPENATS <*> pure (fsLit "KnownNat") <*> pure knownNatClassNameKey +knownSymbolClassName :: WiredIn Name +knownSymbolClassName = clsQual <$> gHC_TYPELITS <*> pure (fsLit "KnownSymbol") <*> pure knownSymbolClassNameKey +knownCharClassName :: WiredIn Name +knownCharClassName = clsQual <$> gHC_TYPELITS <*> pure (fsLit "KnownChar") <*> pure knownCharClassNameKey -- Overloaded labels -fromLabelClassOpName :: Name +fromLabelClassOpName :: WiredIn Name fromLabelClassOpName - = varQual gHC_OVER_LABELS (fsLit "fromLabel") fromLabelClassOpKey + = varQual <$> gHC_OVER_LABELS <*> pure (fsLit "fromLabel") <*> pure fromLabelClassOpKey -- Implicit Parameters -ipClassName :: Name +ipClassName :: WiredIn Name ipClassName - = clsQual gHC_CLASSES (fsLit "IP") ipClassKey + = clsQual <$> gHC_CLASSES <*> pure (fsLit "IP") <*> pure ipClassKey -- Overloaded record fields -hasFieldClassName :: Name +hasFieldClassName :: WiredIn Name hasFieldClassName - = clsQual gHC_RECORDS (fsLit "HasField") hasFieldClassNameKey + = clsQual <$> gHC_RECORDS <*> pure (fsLit "HasField") <*> pure hasFieldClassNameKey -- Source Locations callStackTyConName, emptyCallStackName, pushCallStackName, - srcLocDataConName :: Name + srcLocDataConName :: WiredIn Name callStackTyConName - = tcQual gHC_STACK_TYPES (fsLit "CallStack") callStackTyConKey + = tcQual <$> gHC_STACK_TYPES <*> pure (fsLit "CallStack") <*> pure callStackTyConKey emptyCallStackName - = varQual gHC_STACK_TYPES (fsLit "emptyCallStack") emptyCallStackKey + = varQual <$> gHC_STACK_TYPES <*> pure (fsLit "emptyCallStack") <*> pure emptyCallStackKey pushCallStackName - = varQual gHC_STACK_TYPES (fsLit "pushCallStack") pushCallStackKey + = varQual <$> gHC_STACK_TYPES <*> pure (fsLit "pushCallStack") <*> pure pushCallStackKey srcLocDataConName - = dcQual gHC_STACK_TYPES (fsLit "SrcLoc") srcLocDataConKey + = dcQual <$> gHC_STACK_TYPES <*> pure (fsLit "SrcLoc") <*> pure srcLocDataConKey -- plugins -pLUGINS :: Module -pLUGINS = mkThisGhcModule (fsLit "GHC.Driver.Plugins") -pluginTyConName :: Name -pluginTyConName = tcQual pLUGINS (fsLit "Plugin") pluginTyConKey -frontendPluginTyConName :: Name -frontendPluginTyConName = tcQual pLUGINS (fsLit "FrontendPlugin") frontendPluginTyConKey +pLUGINS :: IO (WiredIn Module) +pLUGINS = pure $ mkThisGhcModule (fsLit "GHC.Driver.Plugins") +pluginTyConName :: IO (WiredIn Name) +pluginTyConName = pLUGINS >>= \plugin_mod -> pure (tcQual <$> plugin_mod <*> pure (fsLit "Plugin") <*> pure pluginTyConKey) +frontendPluginTyConName :: IO Name +frontendPluginTyConName = pLUGINS >>= \plugin_mod -> pure (tcQual <$> plugin_mod <*> pure (fsLit "FrontendPlugin") <*> pure frontendPluginTyConKey) -- Static pointers -makeStaticName :: Name +makeStaticName :: WiredIn Name makeStaticName = - varQual gHC_STATICPTR_INTERNAL (fsLit "makeStatic") makeStaticKey + varQual <$> gHC_STATICPTR_INTERNAL <*> pure (fsLit "makeStatic") <*> pure makeStaticKey -staticPtrInfoTyConName :: Name +staticPtrInfoTyConName :: WiredIn Name staticPtrInfoTyConName = - tcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoTyConKey + tcQual <$> gHC_STATICPTR <*> pure (fsLit "StaticPtrInfo") <*> pure staticPtrInfoTyConKey -staticPtrInfoDataConName :: Name +staticPtrInfoDataConName :: WiredIn Name staticPtrInfoDataConName = - dcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoDataConKey + dcQual <$> gHC_STATICPTR <*> pure (fsLit "StaticPtrInfo") <*> pure staticPtrInfoDataConKey -staticPtrTyConName :: Name +staticPtrTyConName :: WiredIn Name staticPtrTyConName = - tcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrTyConKey + tcQual <$> gHC_STATICPTR <*> pure (fsLit "StaticPtr") <*> pure staticPtrTyConKey -staticPtrDataConName :: Name +staticPtrDataConName :: WiredIn Name staticPtrDataConName = - dcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey + dcQual <$> gHC_STATICPTR <*> pure (fsLit "StaticPtr") <*> pure staticPtrDataConKey -fromStaticPtrName :: Name +fromStaticPtrName :: WiredIn Name fromStaticPtrName = - varQual gHC_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey + varQual <$> gHC_STATICPTR <*> pure (fsLit "fromStaticPtr") <*> pure fromStaticPtrClassOpKey -fingerprintDataConName :: Name +fingerprintDataConName :: WiredIn Name fingerprintDataConName = - dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey + dcQual <$> gHC_FINGERPRINT_TYPE <*> pure (fsLit "Fingerprint") <*> pure fingerprintDataConKey -constPtrConName :: Name +constPtrConName :: WiredIn Name constPtrConName = - tcQual fOREIGN_C_CONSTPTR (fsLit "ConstPtr") constPtrTyConKey + tcQual <$> fOREIGN_C_CONSTPTR <*> pure (fsLit "ConstPtr") <*> pure constPtrTyConKey {- ************************************************************************ ===================================== compiler/GHC/Builtin/Utils.hs ===================================== @@ -113,7 +113,7 @@ Note [About wired-in things] -- | This list is used to ensure that when you say "Prelude.map" in your source -- code, or in an interface file, you get a Name with the correct known key (See -- Note [Known-key names] in "GHC.Builtin.Names") -knownKeyNames :: [Name] +knownKeyNames :: IO [Name] knownKeyNames | debugIsOn , Just badNamesStr <- knownKeyNamesOkay all_names @@ -123,7 +123,7 @@ knownKeyNames -- "<
>" error. (This seems to happen only in the -- stage 2 compiler, for reasons I [Richard] have no clue of.) | otherwise - = all_names + = (++) all_names <$> basicKnownKeyNames where all_names = concat [ concatMap wired_tycon_kk_names primTyCons @@ -132,7 +132,6 @@ knownKeyNames , map idName wiredInIds , map idName allThePrimOpIds , map (idName . primOpWrapperId) allThePrimOps - , basicKnownKeyNames , templateHaskellNames ] -- All of the names associated with a wired-in TyCon. @@ -189,22 +188,22 @@ knownKeyNamesOkay all_names -- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a -- known-key thing. -lookupKnownKeyName :: Unique -> Maybe Name +lookupKnownKeyName :: Unique -> IO (Maybe Name) lookupKnownKeyName u = - knownUniqueName u <|> lookupUFM_Directly knownKeysMap u + (knownUniqueName u <|>) . flip lookupUFM_Directly u <$> knownKeysMap -- | Is a 'Name' known-key? -isKnownKeyName :: Name -> Bool +isKnownKeyName :: Name -> IO Bool isKnownKeyName n = - isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap + (isJust (knownUniqueName $ nameUnique n) ||) . elemUFM n <$> knownKeysMap -- | Maps 'Unique's to known-key names. -- -- The type is @UniqFM Name Name@ to denote that the 'Unique's used -- in the domain are 'Unique's associated with 'Name's (as opposed -- to some other namespace of 'Unique's). -knownKeysMap :: UniqFM Name Name -knownKeysMap = listToIdentityUFM knownKeyNames +knownKeysMap :: IO (UniqFM Name Name) +knownKeysMap = listToIdentityUFM <$> knownKeyNames -- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by -- GHCi's ':info' command. ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -235,8 +235,7 @@ withBkpSession cid insts deps session_type do_this = do , importPaths = [] -- Synthesize the flags , packageFlags = packageFlags dflags ++ map (\(uid0, rn) -> - let uid = unwireUnit unit_state - $ improveUnit unit_state + let uid = improveUnit unit_state $ renameHoleUnit unit_state (listToUFM insts) uid0 in ExposePackage (showSDoc dflags @@ -372,7 +371,7 @@ buildUnit session cid insts lunit = do -- really used for anything, so we leave it -- blank for now. TcSession -> [] - _ -> map (toUnitId . unwireUnit state) + _ -> map toUnitId $ deps ++ [ moduleUnit mod | (_, mod) <- insts , not (isHoleModule mod) ], ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -305,7 +305,8 @@ newHscEnv top_dir dflags = newHscEnvWithHUG top_dir dflags (homeUnitId_ dflags) newHscEnvWithHUG :: FilePath -> DynFlags -> UnitId -> HomeUnitGraph -> IO HscEnv newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do - nc_var <- initNameCache 'r' knownKeyNames + knownKeyNames' <- knownKeyNames + nc_var <- initNameCache 'r' knownKeyNames' fc_var <- initFinderCache logger <- initLogger tmpfs <- initTmpFs ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE BinaryLiterals, ScopedTypeVariables #-} +{-# LANGUAGE BinaryLiterals, ScopedTypeVariables, LambdaCase #-} -- -- (c) The University of Glasgow 2002-2006 @@ -336,18 +336,17 @@ putName _dict BinSymbolTable{ bin_symtab_map = symtab_map_ref, bin_symtab_next = symtab_next } bh name - | isKnownKeyName name - , let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits = -- assert (u < 2^(22 :: Int)) - put_ bh (0x80000000 - .|. (fromIntegral (ord c) `shiftL` 22) - .|. (fromIntegral u :: Word32)) - - | otherwise - = do symtab_map <- readIORef symtab_map_ref - case lookupUFM symtab_map name of - Just (off,_) -> put_ bh (fromIntegral off :: Word32) - Nothing -> do + isKnownKeyName name >>= \case + True -> let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits + in put_ bh (0x80000000 + .|. (fromIntegral (ord c) `shiftL` 22) + .|. (fromIntegral u :: Word32)) + False -> do + symtab_map <- readIORef symtab_map_ref + case lookupUFM symtab_map name of + Just (off,_) -> put_ bh (fromIntegral off :: Word32) + Nothing -> do off <- readFastMutInt symtab_next -- massert (off < 2^(30 :: Int)) writeFastMutInt symtab_next (off+1) @@ -370,10 +369,10 @@ getSymtabName _name_cache _dict symtab bh = do ix = fromIntegral i .&. 0x003FFFFF u = mkUnique tag ix in - return $! case lookupKnownKeyName u of - Nothing -> pprPanic "getSymtabName:unknown known-key unique" - (ppr i $$ ppr u $$ char tag $$ ppr ix) - Just n -> n + lookupKnownKeyName u >>= \case + Nothing -> pprPanic "getSymtabName:unknown known-key unique" + (ppr i $$ ppr u $$ char tag $$ ppr ix) + Just n -> return $! n _ -> pprPanic "getSymtabName:unknown name tag" (ppr i) ===================================== compiler/GHC/Iface/Ext/Binary.hs ===================================== @@ -3,6 +3,7 @@ Binary serialization for .hie files. -} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} module GHC.Iface.Ext.Binary ( readHieFile @@ -291,15 +292,18 @@ putName (HieSymbolTable next ref) bh name = do let hieName = ExternalName mod occ (nameSrcSpan name) writeIORef ref $! addToUFM symmap name (off, hieName) put_ bh (fromIntegral off :: Word32) - Just (off, LocalName _occ span) - | notLocal (toHieName name) || nameSrcSpan name /= span -> do - writeIORef ref $! addToUFM symmap name (off, toHieName name) - put_ bh (fromIntegral off :: Word32) + Just (off, LocalName _occ span) -> do + hieName <- toHieName name + if notLocal (hieName) || nameSrcSpan name /= span then do + writeIORef ref $! addToUFM symmap name (off, hieName) + put_ bh (fromIntegral off :: Word32) + else put_ bh (fromIntegral off :: Word32) -- ROMES:TODO can we not duplicate this here as below? Just (off, _) -> put_ bh (fromIntegral off :: Word32) Nothing -> do + hieName <- toHieName name off <- readFastMutInt next writeFastMutInt next (off+1) - writeIORef ref $! addToUFM symmap name (off, toHieName name) + writeIORef ref $! addToUFM symmap name (off, hieName) put_ bh (fromIntegral off :: Word32) where @@ -328,7 +332,7 @@ fromHieName nc hie_name = do -- don't update the NameCache for local names pure $ mkInternalName uniq occ span - KnownKeyName u -> case lookupKnownKeyName u of + KnownKeyName u -> lookupKnownKeyName u >>= \case Nothing -> pprPanic "fromHieName:unknown known-key unique" (ppr u) Just n -> pure n ===================================== compiler/GHC/Iface/Ext/Debug.hs ===================================== @@ -22,6 +22,8 @@ import qualified Data.Set as S import Data.Function ( on ) import Data.List ( sortOn ) +import System.IO.Unsafe ( unsafePerformIO ) + type Diff a = a -> a -> [SDoc] diffFile :: Diff HieFile @@ -64,10 +66,10 @@ diffAst diffType (Node info1 span1 xs1) (Node info2 span2 xs2) = type DiffIdent = Either ModuleName HieName normalizeIdents :: Ord a => NodeIdentifiers a -> [(DiffIdent,IdentifierDetails a)] -normalizeIdents = sortOn go . map (first toHieName) . M.toList +normalizeIdents = sortOn go . map (first (unsafePerformIO . toHieName)) . M.toList where first f (a,b) = (fmap f a, b) - go (a,b) = (hieNameOcc <$> a,identInfo b,identType b) + go (a,b) = (unsafePerformIO . hieNameOcc <$> a,identInfo b,identType b) diffList :: Diff a -> Diff [a] diffList f xs ys ===================================== compiler/GHC/Iface/Ext/Types.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} @@ -42,6 +43,8 @@ import Data.Coerce ( coerce ) import Data.Function ( on ) import qualified Data.Semigroup as S +import System.IO.Unsafe ( unsafePerformIO ) + type Span = RealSrcSpan -- | Current version of @.hie@ files @@ -581,10 +584,10 @@ newtype EvBindDeps = EvBindDeps { getEvBindDeps :: [Name] } deriving Outputable instance Eq EvBindDeps where - (==) = coerce ((==) `on` map toHieName) + (==) = coerce ((==) `on` map (unsafePerformIO . toHieName)) instance Ord EvBindDeps where - compare = coerce (compare `on` map toHieName) + compare = coerce (compare `on` map (unsafePerformIO . toHieName)) instance Binary EvBindDeps where put_ bh (EvBindDeps xs) = put_ bh xs @@ -767,19 +770,25 @@ instance Outputable HieName where ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u -hieNameOcc :: HieName -> OccName -hieNameOcc (ExternalName _ occ _) = occ -hieNameOcc (LocalName occ _) = occ +-- Why do we need IO? See Note [Looking up known key names] +hieNameOcc :: HieName -> IO OccName +hieNameOcc (ExternalName _ occ _) = pure occ +hieNameOcc (LocalName occ _) = pure occ hieNameOcc (KnownKeyName u) = - case lookupKnownKeyName u of - Just n -> nameOccName n + lookupKnownKeyName u >>= \case + Just n -> pure (nameOccName n) Nothing -> pprPanic "hieNameOcc:unknown known-key unique" (ppr u) -toHieName :: Name -> HieName -toHieName name - | isKnownKeyName name = KnownKeyName (nameUnique name) - | isExternalName name = ExternalName (nameModule name) - (nameOccName name) - (removeBufSpan $ nameSrcSpan name) - | otherwise = LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name) +-- Why do we need IO? See Note [Looking up known key names] +toHieName :: Name -> IO HieName +toHieName name = + isKnownKeyName name >>= \case + True -> pure (KnownKeyName (nameUnique name)) + False + | isExternalName name -> + pure $ ExternalName (nameModule name) + (nameOccName name) + (removeBufSpan $ nameSrcSpan name) + | otherwise -> + pure $ LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name) ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -138,15 +138,17 @@ loadPlugins hsc_env where options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags , opt_mod_nm == mod_nm ] - loadPlugin = loadPlugin' (mkVarOccFS (fsLit "plugin")) pluginTyConName hsc_env + loadPlugin p = pluginTyConName >>= \pluginTyConName' -> loadPlugin' (mkVarOccFS (fsLit "plugin")) pluginTyConName' hsc_env p loadFrontendPlugin :: HscEnv -> ModuleName -> IO (FrontendPlugin, [Linkable], PkgsLoaded) loadFrontendPlugin hsc_env mod_name = do checkExternalInterpreter hsc_env (plugin, _iface, links, pkgs) - <- loadPlugin' (mkVarOccFS (fsLit "frontendPlugin")) frontendPluginTyConName - hsc_env mod_name + <- frontendPluginTyConName >>= + \frontendPluginTCN -> + loadPlugin' (mkVarOccFS (fsLit "frontendPlugin")) frontendPluginTCN + hsc_env mod_name return (plugin, links, pkgs) -- #14335 @@ -168,7 +170,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name [ text "The module", ppr mod_name , text "did not export the plugin name" , ppr plugin_rdr_name ]) ; - Just (name, mod_iface) -> + Just (name, mod_iface) -> pprTrace "ROMES: Current unit" (ppr . ue_current_unit . hsc_unit_env $ hsc_env) $ do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name ; eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) ===================================== compiler/GHC/Tc/Errors/Hole.hs ===================================== @@ -597,6 +597,7 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _ ; traceTc "hole_lvl is:" $ ppr hole_lvl ; traceTc "simples are: " $ ppr simples ; traceTc "locals are: " $ ppr lclBinds + ; builtIns' <- liftIO builtIns ; let (lcl, gbl) = partition gre_lcl (globalRdrEnvElts rdr_env) -- We remove binding shadowings here, but only for the local level. -- this is so we e.g. suggest the global fmap from the Functor class @@ -605,7 +606,7 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _ locals = removeBindingShadowing $ map IdHFCand lclBinds ++ map GreHFCand lcl globals = map GreHFCand gbl - syntax = map NameHFCand builtIns + syntax = map NameHFCand builtIns' -- If the hole is a rigid type-variable, then we only check the -- locals, since only they can match the type (in a meaningful way). only_locals = any isImmutableTyVar $ getTyVar_maybe hole_ty @@ -663,8 +664,8 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _ hole_lvl = ctLocLevel ct_loc -- BuiltInSyntax names like (:) and [] - builtIns :: [Name] - builtIns = filter isBuiltInSyntax knownKeyNames + builtIns :: IO [Name] + builtIns = filter isBuiltInSyntax <$> knownKeyNames -- We make a refinement type by adding a new type variable in front -- of the type of t h hole, going from e.g. [Integer] -> Integer ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -69,7 +69,6 @@ module GHC.Unit.State ( pprWithUnitState, -- * Utils - unwireUnit, implicitPackageDeps) where @@ -108,6 +107,7 @@ import GHC.Utils.Exception import System.Directory import System.FilePath as FilePath import Control.Monad +import Data.IORef import Data.Graph (stronglyConnComp, SCC(..)) import Data.Char ( toUpper ) import Data.List ( intersperse, partition, sortBy, isSuffixOf ) @@ -410,7 +410,7 @@ type ModuleNameProvidersMap = Map ModuleName (Map Module ModuleOrigin) data UnitState = UnitState { - -- | A mapping of 'Unit' to 'UnitInfo'. This list is adjusted + -- | A mapping of 'UnitId' to 'UnitInfo'. This list is adjusted -- so that only valid units are here. 'UnitInfo' reflects -- what was stored *on disk*, except for the 'trusted' flag, which -- is adjusted at runtime. (In particular, some units in this map @@ -430,12 +430,6 @@ data UnitState = UnitState { -- And also to resolve package qualifiers with the PackageImports extension. packageNameMap :: UniqFM PackageName UnitId, - -- | A mapping from database unit keys to wired in unit ids. - wireMap :: Map UnitId UnitId, - - -- | A mapping from wired in unit ids to unit keys from the database. - unwireMap :: Map UnitId UnitId, - -- | The units we're going to link in eagerly. This list -- should be in reverse dependency order; that is, a unit -- is always mentioned before the units it depends on. @@ -478,8 +472,6 @@ emptyUnitState = UnitState { unitInfoMap = Map.empty, preloadClosure = emptyUniqSet, packageNameMap = emptyUFM, - wireMap = Map.empty, - unwireMap = Map.empty, preloadUnits = [], explicitUnits = [], homeUnitDepends = [], @@ -649,7 +641,7 @@ initUnits logger dflags cached_dbs home_units = do -- Try to find platform constants -- -- See Note [Platform constants] in GHC.Platform - mconstants <- if homeUnitId_ dflags == rtsUnitId + mconstants <- pprTrace "initUnits" (ppr (homeUnitId_ dflags, rtsUnitId)) $ if homeUnitId_ dflags == rtsUnitId then do -- we're building the RTS! Lookup DerivedConstants.h in the include paths lookupPlatformConstants (includePathsGlobal (includePaths dflags)) @@ -671,13 +663,8 @@ mkHomeUnit -> Maybe UnitId -- ^ Home unit instance of -> [(ModuleName, Module)] -- ^ Home unit instantiations -> HomeUnit -mkHomeUnit unit_state hu_id hu_instanceof hu_instantiations_ = - let - -- Some wired units can be used to instantiate the home unit. We need to - -- replace their unit keys with their wired unit ids. - wmap = wireMap unit_state - hu_instantiations = map (fmap (upd_wired_in_mod wmap)) hu_instantiations_ - in case (hu_instanceof, hu_instantiations) of +mkHomeUnit unit_state hu_id hu_instanceof hu_instantiations = + case (hu_instanceof, hu_instantiations) of (Nothing,[]) -> DefiniteHomeUnit hu_id Nothing (Nothing, _) -> throwGhcException $ CmdLineError ("Use of -instantiated-with requires -this-component-id") (Just _, []) -> throwGhcException $ CmdLineError ("Use of -this-component-id requires -instantiated-with") @@ -1080,8 +1067,6 @@ pprTrustFlag flag = case flag of -- -- See Note [Wired-in units] in GHC.Unit.Types -type WiringMap = Map UnitId UnitId - findWiredInUnits :: Logger -> UnitPrecedenceMap @@ -1096,8 +1081,9 @@ findWiredInUnits logger prec_map pkgs vis_map = do -- their canonical names (eg. base-1.0 ==> base), as described -- in Note [Wired-in units] in GHC.Unit.Types let - matches :: UnitInfo -> UnitId -> Bool - pc `matches` pid = unitPackageName pc == PackageName (unitIdFS pid) + -- Match a package name against a UnitInfo + matches :: UnitInfo -> FastString -> Bool + pc `matches` pname = unitPackageName pc == PackageName pname -- find which package corresponds to each wired-in package -- delete any other packages with the same name @@ -1116,10 +1102,10 @@ findWiredInUnits logger prec_map pkgs vis_map = do -- this works even when there is no exposed wired in package -- available. -- - findWiredInUnit :: [UnitInfo] -> UnitId -> IO (Maybe (UnitId, UnitInfo)) - findWiredInUnit pkgs wired_pkg = firstJustsM [try all_exposed_ps, try all_ps, notfound] + findWiredInUnitByName :: [UnitInfo] -> WiredInPackageName -> IO (Maybe (FastString, UnitInfo)) + findWiredInUnitByName pkgs (WiredInPackageName wired_pkg_name) = firstJustsM [try all_exposed_ps, try all_ps, notfound] -- ROMES:TODO: In fact, here we ? where - all_ps = [ p | p <- pkgs, p `matches` wired_pkg ] + all_ps = [ p | p <- pkgs, p `matches` wired_pkg_name ] all_exposed_ps = [ p | p <- all_ps, Map.member (mkUnit p) vis_map ] try ps = case sortByPreference prec_map ps of @@ -1129,33 +1115,34 @@ findWiredInUnits logger prec_map pkgs vis_map = do notfound = do debugTraceMsg logger 2 $ text "wired-in package " - <> ftext (unitIdFS wired_pkg) + <> ftext wired_pkg_name <> text " not found." return Nothing - pick :: UnitInfo -> IO (UnitId, UnitInfo) + + pick :: UnitInfo -> IO (FastString, UnitInfo) pick pkg = do debugTraceMsg logger 2 $ text "wired-in package " - <> ftext (unitIdFS wired_pkg) + <> ftext wired_pkg_name <> text " mapped to " <> ppr (unitId pkg) - return (wired_pkg, pkg) + return (wired_pkg_name, pkg) - mb_wired_in_pkgs <- mapM (findWiredInUnit pkgs) wiredInUnitIds + mb_wired_in_pkgs <- mapM (findWiredInUnitByName pkgs) wiredInUnitNames let wired_in_pkgs = catMaybes mb_wired_in_pkgs - wiredInMap :: Map UnitId UnitId + wiredInMap :: Map WiredInPackageName UnitId wiredInMap = Map.fromList - [ (unitId realUnitInfo, wiredInUnitId) - | (wiredInUnitId, realUnitInfo) <- wired_in_pkgs + [ (WiredInPackageName wiredInUnitName, unitId realUnitInfo) + | (wiredInUnitName, realUnitInfo) <- wired_in_pkgs , not (unitIsIndefinite realUnitInfo) ] - updateWiredInDependencies pkgs = map (upd_deps . upd_pkg) pkgs + updateWiredInDependencies pkgs = map upd_pkg pkgs where upd_pkg pkg - | Just wiredInUnitId <- Map.lookup (unitId pkg) wiredInMap + | Just wiredInUnitId <- Map.lookup (WiredInPackageName $ unitIdFS $ unitId pkg) wiredInMap = pkg { unitId = wiredInUnitId , unitInstanceOf = wiredInUnitId -- every non instantiated unit is an instance of @@ -1165,12 +1152,11 @@ findWiredInUnits logger prec_map pkgs vis_map = do } | otherwise = pkg - upd_deps pkg = pkg { - unitDepends = map (upd_wired_in wiredInMap) (unitDepends pkg), - unitExposedModules - = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v)) - (unitExposedModules pkg) - } + -- upd_deps pkg = pkg { + -- unitExposedModules + -- = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v)) + -- (unitExposedModules pkg) + -- } return (updateWiredInDependencies pkgs, wiredInMap) @@ -1182,30 +1168,26 @@ findWiredInUnits logger prec_map pkgs vis_map = do -- For instance, base-4.9.0.0 will be rewritten to just base, to match -- what appears in GHC.Builtin.Names. -upd_wired_in_mod :: WiringMap -> Module -> Module -upd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m - -upd_wired_in_uid :: WiringMap -> Unit -> Unit -upd_wired_in_uid wiredInMap u = case u of - HoleUnit -> HoleUnit - RealUnit (Definite uid) -> RealUnit (Definite (upd_wired_in wiredInMap uid)) - VirtUnit indef_uid -> - VirtUnit $ mkInstantiatedUnit - (instUnitInstanceOf indef_uid) - (map (\(x,y) -> (x,upd_wired_in_mod wiredInMap y)) (instUnitInsts indef_uid)) - -upd_wired_in :: WiringMap -> UnitId -> UnitId -upd_wired_in wiredInMap key - | Just key' <- Map.lookup key wiredInMap = key' - | otherwise = key - -updateVisibilityMap :: WiringMap -> VisibilityMap -> VisibilityMap -updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap) - where f vm (from, to) = case Map.lookup (RealUnit (Definite from)) vis_map of - Nothing -> vm - Just r -> Map.insert (RealUnit (Definite to)) r - (Map.delete (RealUnit (Definite from)) vm) - +-- upd_wired_in_mod :: WiringMap -> Module -> Module +-- upd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m +-- +-- upd_wired_in_uid :: WiringMap -> Unit -> Unit +-- upd_wired_in_uid wiredInMap u = case u of +-- HoleUnit -> HoleUnit +-- RealUnit (Definite uid) -> RealUnit (Definite uid) +-- VirtUnit indef_uid -> +-- VirtUnit $ mkInstantiatedUnit +-- (instUnitInstanceOf indef_uid) +-- (map (\(x,y) -> (x,upd_wired_in_mod wiredInMap y)) (instUnitInsts indef_uid)) + +-- This function was updating the wired-in names in the visibility map to the +-- actual wired-in names, no longer needed. It wasn't actually changing the visibility of anything +-- updateVisibilityMap :: WiringMap -> VisibilityMap -> VisibilityMap +-- updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap) +-- where f vm (from, to) = case Map.lookup (RealUnit (Definite from)) vis_map of +-- Nothing -> vm +-- Just r -> Map.insert (RealUnit (Definite to)) r +-- (Map.delete (RealUnit (Definite from)) vm) -- ---------------------------------------------------------------------------- @@ -1597,7 +1579,7 @@ mkUnitState logger cfg = do -- -hide-package). This needs to know about the unusable packages, since if a -- user tries to enable an unusable package, we should let them know. -- - vis_map2 <- mayThrowUnitErr + vis_map <- mayThrowUnitErr $ foldM (applyPackageFlag prec_map prelim_pkg_db emptyUniqSet unusable (unitConfigHideAll cfg) pkgs1) vis_map1 other_flags @@ -1607,13 +1589,11 @@ mkUnitState logger cfg = do -- it modifies the unit ids of wired in packages, but when we process -- package arguments we need to key against the old versions. -- - (pkgs2, wired_map) <- findWiredInUnits logger prec_map pkgs1 vis_map2 - let pkg_db = mkUnitInfoMap pkgs2 + (pkgs2, !wired_map) <- findWiredInUnits logger prec_map pkgs1 vis_map - -- Update the visibility map, so we treat wired packages as visible. - let vis_map = updateVisibilityMap wired_map vis_map2 + let pkg_db = mkUnitInfoMap pkgs2 - let hide_plugin_pkgs = unitConfigHideAllPlugins cfg + hide_plugin_pkgs = unitConfigHideAllPlugins cfg plugin_vis_map <- case unitConfigFlagsPlugins cfg of -- common case; try to share the old vis_map @@ -1624,22 +1604,20 @@ mkUnitState logger cfg = do -- Use the vis_map PRIOR to wired in, -- because otherwise applyPackageFlag -- won't work. - | otherwise = vis_map2 - plugin_vis_map2 + -- ROMES:TODO: update applyPackageFlag st it doesn't expected the previous wired-in names + | otherwise = vis_map + plugin_vis_map <- mayThrowUnitErr $ foldM (applyPackageFlag prec_map prelim_pkg_db emptyUniqSet unusable hide_plugin_pkgs pkgs1) plugin_vis_map1 (reverse (unitConfigFlagsPlugins cfg)) - -- Updating based on wired in packages is mostly - -- good hygiene, because it won't matter: no wired in - -- package has a compiler plugin. -- TODO: If a wired in package had a compiler plugin, -- and you tried to pick different wired in packages -- with the plugin flags and the normal flags... what -- would happen? I don't know! But this doesn't seem -- likely to actually happen. - return (updateVisibilityMap wired_map plugin_vis_map2) + return (plugin_vis_map) let pkgname_map = listToUFM [ (unitPackageName p, unitInstanceOf p) | p <- pkgs2 @@ -1691,11 +1669,11 @@ mkUnitState logger cfg = do , moduleNameProvidersMap = mod_map , pluginModuleNameProvidersMap = mkModuleNameProvidersMap logger cfg pkg_db emptyUniqSet plugin_vis_map , packageNameMap = pkgname_map - , wireMap = wired_map - , unwireMap = Map.fromList [ (v,k) | (k,v) <- Map.toList wired_map ] , requirementContext = req_ctx , allowVirtualUnits = unitConfigAllowVirtual cfg } + + pprTrace "findWiredInUnits" (ppr wired_map) $ writeIORef workingThisOut wired_map return (state, raw_dbs) selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool @@ -1710,14 +1688,6 @@ selectHomeUnits home_units flags = foldl' go Set.empty flags -- MP: This does not yet support thinning/renaming go cur _ = cur - --- | Given a wired-in 'Unit', "unwire" it into the 'Unit' --- that it was recorded as in the package database. -unwireUnit :: UnitState -> Unit -> Unit -unwireUnit state uid@(RealUnit (Definite def_uid)) = - maybe uid (RealUnit . Definite) (Map.lookup def_uid (unwireMap state)) -unwireUnit _ uid = uid - -- ----------------------------------------------------------------------------- -- | Makes the mapping from ModuleName to package info ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Unit & Module types @@ -35,6 +36,9 @@ module GHC.Unit.Types , DefUnitId , Instantiations , GenInstantiations + , WiredIn + , WiringMap + , WiredInPackageName (..) , mkInstantiatedUnit , mkInstantiatedUnitHash , mkVirtUnit @@ -79,7 +83,7 @@ module GHC.Unit.Types , interactiveUnit , isInteractiveModule - , wiredInUnitIds + , wiredInUnitNames -- * Boot modules , IsBootInterface (..) @@ -101,10 +105,14 @@ import GHC.Utils.Fingerprint import GHC.Utils.Misc import Control.DeepSeq +import Control.Monad.Trans.Reader import Data.Data import Data.List (sortBy ) import Data.Function import Data.Bifunctor +import Data.IORef +import Data.Map (Map) +import qualified Data.Map as Map import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS.Char8 @@ -544,6 +552,11 @@ unitIdString = unpackFS . unitIdFS stringToUnitId :: String -> UnitId stringToUnitId = UnitId . mkFastString +newtype WiredInPackageName = WiredInPackageName + { wiredInPackageNameFS :: FastString } + deriving (Data) + deriving (Binary, Eq, Ord, Uniquable, Outputable) via UnitId + --------------------------------------------------------------------- -- UTILS --------------------------------------------------------------------- @@ -587,45 +600,75 @@ Make sure you change 'GHC.Unit.State.findWiredInUnits' if you add an entry here. -} +type WiringMap = Map WiredInPackageName UnitId +type WiredIn = Reader WiringMap + +bignumUnitName, primUnitName, baseUnitName, rtsUnitName, + thUnitName, mainUnitName, thisGhcUnitName, interactiveUnitName :: WiredInPackageName + bignumUnitId, primUnitId, baseUnitId, rtsUnitId, - thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId + thUnitId, thisGhcUnitId :: WiredIn UnitId +mainUnitId, interactiveUnitId :: UnitId bignumUnit, primUnit, baseUnit, rtsUnit, - thUnit, mainUnit, thisGhcUnit, interactiveUnit :: Unit - -primUnitId = UnitId (fsLit "ghc-prim") -bignumUnitId = UnitId (fsLit "ghc-bignum") -baseUnitId = UnitId (fsLit "base") -rtsUnitId = UnitId (fsLit "rts") -thisGhcUnitId = UnitId (fsLit "ghc") -interactiveUnitId = UnitId (fsLit "interactive") -thUnitId = UnitId (fsLit "template-haskell") - -thUnit = RealUnit (Definite thUnitId) -primUnit = RealUnit (Definite primUnitId) -bignumUnit = RealUnit (Definite bignumUnitId) -baseUnit = RealUnit (Definite baseUnitId) -rtsUnit = RealUnit (Definite rtsUnitId) -thisGhcUnit = RealUnit (Definite thisGhcUnitId) + thUnit, thisGhcUnit :: WiredIn Unit +mainUnit, interactiveUnit :: Unit + +primUnitName = WiredInPackageName $ fsLit "ghc-prim" +bignumUnitName = WiredInPackageName $ fsLit "ghc-bignum" +baseUnitName = WiredInPackageName $ fsLit "base" +rtsUnitName = WiredInPackageName $ fsLit "rts" +thisGhcUnitName = WiredInPackageName $ fsLit "ghc" +interactiveUnitName = WiredInPackageName $ fsLit "interactive" +thUnitName = WiredInPackageName $ fsLit "template-haskell" + +primUnitId = mkWiredInUnitId primUnitName +bignumUnitId = mkWiredInUnitId bignumUnitName +baseUnitId = mkWiredInUnitId baseUnitName +rtsUnitId = mkWiredInUnitId rtsUnitName +thisGhcUnitId = mkWiredInUnitId thisGhcUnitName +interactiveUnitId = UnitId $ wiredInPackageNameFS interactiveUnitName +thUnitId = mkWiredInUnitId thUnitName + +thUnit = RealUnit . Definite <$> thUnitId +primUnit = RealUnit . Definite <$> primUnitId +bignumUnit = RealUnit . Definite <$> bignumUnitId +baseUnit = RealUnit . Definite <$> baseUnitId +rtsUnit = RealUnit . Definite <$> rtsUnitId +thisGhcUnit = RealUnit . Definite <$> thisGhcUnitId interactiveUnit = RealUnit (Definite interactiveUnitId) -- | This is the package Id for the current program. It is the default -- package Id if you don't specify a package name. We don't add this prefix -- to symbol names, since there can be only one main package per program. -mainUnitId = UnitId (fsLit "main") +mainUnitName = WiredInPackageName $ fsLit "main" +mainUnitId = UnitId $ wiredInPackageNameFS mainUnitName mainUnit = RealUnit (Definite mainUnitId) +-- Make the actual unit id the result of looking up the wired-in unit package name in the wire map +mkWiredInUnitId :: WiredInPackageName -> WiredIn UnitId +mkWiredInUnitId name = ask >>= \wiring_map -> case Map.lookup name wiring_map of + Nothing -> pure $ pprTrace "Romes:Couldn't find UnitId" (ppr (name,wiring_map)) $ UnitId $ wiredInPackageNameFS name + -- case x of + -- rtsUnitName -> (UnitId $ fsLit "rts") + -- primUnitName -> (UnitId $ fsLit "ghc-prim") + -- this is a fallback, in which situations do + -- we need a fallback? perhaps when booting + -- the compiler with the rts? + Just actual_name -> pure $ pprTrace "Romes:Found in wire map" (ppr name <+> text "->" <> ppr actual_name) actual_name + + isInteractiveModule :: Module -> Bool isInteractiveModule mod = moduleUnit mod == interactiveUnit -wiredInUnitIds :: [UnitId] -wiredInUnitIds = - [ primUnitId - , bignumUnitId - , baseUnitId - , rtsUnitId - , thUnitId - , thisGhcUnitId +wiredInUnitNames :: [WiredInPackageName] +wiredInUnitNames = + [ primUnitName + , bignumUnitName + , baseUnitName + , rtsUnitName + , thUnitName + , thisGhcUnitName ] --------------------------------------------------------------------- ===================================== del-this-unit-id.sh ===================================== @@ -0,0 +1 @@ +sed -i '' 's/ghc-options: -this-unit-id.*//i' compiler/ghc.cabal.in libraries/base/base.cabal libraries/ghc-bignum/ghc-bignum.cabal libraries/ghc-prim/ghc-prim.cabal rts/rts.cabal.in libraries/template-haskell/template-haskell.cabal.in ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -29,6 +29,7 @@ pkgVersion = fmap version . readPackageData -- The Cabal file is tracked. pkgIdentifier :: Package -> Action String pkgIdentifier package = do + -- ROMES:TODO: besides the version, compute a simple hash cabal <- readPackageData package return $ if null (version cabal) then name cabal ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -85,25 +85,12 @@ multiSetup pkg_s = do need (srcs ++ gens) let rexp m = ["-reexported-module", m] let hidir = root "interfaces" pkgPath p - writeFile' (resp_file root p) (intercalate "\n" (th_hack arg_list + writeFile' (resp_file root p) (intercalate "\n" (arg_list ++ modules cd ++ concatMap rexp (reexportModules cd) ++ ["-outputdir", hidir])) return (resp_file root p) - - -- The template-haskell package is compiled with -this-unit-id=template-haskell but - -- everything which depends on it depends on `-package-id-template-haskell-2.17.0.0` - -- and so the logic for detetecting which home-units depend on what is defeated. - -- The workaround here is just to rewrite all the `-package-id` arguments to - -- point to `template-haskell` instead which works for the multi-repl case. - -- See #20887 - th_hack :: [String] -> [String] - th_hack ((isPrefixOf "-package-id template-haskell" -> True) : xs) = "-package-id" : "template-haskell" : xs - th_hack (x:xs) = x : th_hack xs - th_hack [] = [] - - toolRuleBody :: FilePath -> Action () toolRuleBody fp = do mm <- dirMap View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22036aa2f01cb01a24cb203744ad4233dcd0b947...ea020879c3c261a06231fa7f60d84b5caf082835 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22036aa2f01cb01a24cb203744ad4233dcd0b947...ea020879c3c261a06231fa7f60d84b5caf082835 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 11:56:57 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 07 Mar 2023 06:56:57 -0500 Subject: [Git][ghc/ghc][wip/T23051] 2 commits: Wibbles Message-ID: <640726898701d_2c78e9185077c97971@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23051 at Glasgow Haskell Compiler / GHC Commits: b9038e9f by Simon Peyton Jones at 2023-03-07T11:39:13+00:00 Wibbles Tricky! - - - - - 1b10277a by Simon Peyton Jones at 2023-03-07T11:58:09+00:00 More wibbles - - - - - 2 changed files: - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Utils/TcMType.hs Changes: ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1559,7 +1559,7 @@ and we are running simplifyInfer over These are two implication constraints, both of which contain a wanted for the class C. Neither constraint mentions the bound -skolem. We might imagine that these constraint could thus float +skolem. We might imagine that these constraints could thus float out of their implications and then interact, causing beta1 to unify with beta2, but constraints do not currently float out of implications. @@ -1695,12 +1695,11 @@ decideMonoTyVars :: InferMode -- (a) Mentioned in a constraint we can't generalise (the MR) -- (b) Mentioned in the kind of a CoVar; we can't quantify over a CoVar, -- so we must not quantify over a type variable free in its kind --- (c) Free in the kind of the type(s) we are generalising --- (d) Connected by an equality or fundep to +-- (c) Connected by an equality or fundep to -- * a type variable at level < N, or -- * A tyvar subject to (a), (b) or (c) -- Having found all such level-N tyvars that we can't generalise, --- promote them, to elimianate them from further consideration +-- promote them, to eliminate them from further consideration -- -- Also return CoVars that appear free in the final quantified types -- we can't quantify over these, and we must make sure they are in scope @@ -1720,11 +1719,7 @@ decideMonoTyVars infer_mode name_taus psigs candidates ; tc_lvl <- TcM.getTcLevel ; let psig_tys = mkTyVarTys psig_qtvs ++ psig_theta - -- (b) kind_vars are the variables free in the kinds of the taus - kind_vars = foldr (unionVarSet . tyCoVarsOfType . typeKind) - emptyVarSet taus - - -- (c) The co_var_tvs are tvs mentioned in the types of covars or + -- (b) The co_var_tvs are tvs mentioned in the types of covars or -- coercion holes. We can't quantify over these covars, so we -- must include the variable in their types in the mono_tvs. -- E.g. If we can't quantify over co :: k~Type, then we can't @@ -1747,7 +1742,6 @@ decideMonoTyVars infer_mode name_taus psigs candidates -- typecheck/should_compile/tc213 mono_tvs1 = mono_tvs0 `unionVarSet` co_var_tvs - `unionVarSet` kind_vars -- mono_tvs1 is now the set of variables from an outer scope -- (that's mono_tvs0) and the set of covars, closed over kinds. @@ -1830,40 +1824,32 @@ decideMonoTyVars infer_mode name_taus psigs candidates defaultTyVarsAndSimplify :: TcLevel -> [PredType] -- Assumed zonked -> TcM [PredType] -- Guaranteed zonked --- Promote the known-monomorphic tyvars; -- Default any tyvar free in the constraints; -- and re-simplify in case the defaulting allows further simplification defaultTyVarsAndSimplify rhs_tclvl candidates = do { -- Default any kind/levity vars ; DV {dv_kvs = cand_kvs, dv_tvs = cand_tvs} <- candidateQTyVarsOfTypes candidates - -- decideMonoTyVars has promoted any type variable fixed by the - -- type envt, so they won't be chosen by candidateQTyVarsOfTypes - -- Any covars should already be handled by - -- the logic in decideMonoTyVars, which looks at - -- the constraints generated + -- NB1: decideMonoTyVars has promoted any type variable fixed by the + -- type envt, so they won't be chosen by candidateQTyVarsOfTypes + -- NB2: Defaulting for variables free in tau_tys is done later, by quantifyTyVars + -- Hence looking only at 'candidates' + -- NB3: Any covars should already be handled by + -- the logic in decideMonoTyVars, which looks at + -- the constraints generated ; poly_kinds <- xoptM LangExt.PolyKinds - ; mapM_ (default_one poly_kinds True) (dVarSetElems cand_kvs) - ; mapM_ (default_one poly_kinds False) (dVarSetElems (cand_tvs `minusDVarSet` cand_kvs)) + ; let default_kv | poly_kinds = defaultTyVar DefaultKindVars + | otherwise = default_tv + default_tv = defaultTyVar (NonStandardDefaulting DefaultNonStandardTyVars) + ; mapM_ default_kv (dVarSetElems cand_kvs) + ; mapM_ default_tv (dVarSetElems (cand_tvs `minusDVarSet` cand_kvs)) ; simplify_cand candidates } where - default_one poly_kinds is_kind_var tv - | not (isMetaTyVar tv) - = return () - | otherwise - = void $ defaultTyVar - (if not poly_kinds && is_kind_var - then DefaultKindVars - else NonStandardDefaulting DefaultNonStandardTyVars) - -- NB: only pass 'DefaultKindVars' when we know we're dealing with a kind variable. - tv - - -- this common case (no inferred constraints) should be fast - simplify_cand [] = return [] - -- see Note [Unconditionally resimplify constraints when quantifying] + -- See Note [Unconditionally resimplify constraints when quantifying] + simplify_cand [] = return [] -- Fast path simplify_cand candidates = do { clone_wanteds <- newWanteds DefaultOrigin candidates ; WC { wc_simple = simples } <- setTcLevel rhs_tclvl $ ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -45,8 +45,6 @@ module GHC.Tc.Utils.TcMType ( unpackCoercionHole, unpackCoercionHole_maybe, checkCoercionHole, - ConcreteHole, newConcreteHole, - newImplication, -------------------------------- @@ -414,23 +412,6 @@ checkCoercionHole cv co | otherwise = False --- | A coercion hole used to store evidence for `Concrete#` constraints. --- --- See Note [The Concrete mechanism]. -type ConcreteHole = CoercionHole - --- | Create a new (initially unfilled) coercion hole, --- to hold evidence for a @'Concrete#' (ty :: ki)@ constraint. -newConcreteHole :: Kind -- ^ Kind of the thing we want to ensure is concrete (e.g. 'runtimeRepTy') - -> Type -- ^ Thing we want to ensure is concrete (e.g. some 'RuntimeRep') - -> TcM (ConcreteHole, TcType) - -- ^ where to put the evidence, and a metavariable to store - -- the concrete type -newConcreteHole ki ty - = do { concrete_ty <- newFlexiTyVarTy ki - ; let co_ty = mkHeteroPrimEqPred ki ki ty concrete_ty - ; hole <- newCoercionHole co_ty - ; return (hole, concrete_ty) } {- ********************************************************************** * @@ -1467,9 +1448,6 @@ collect_cand_qtvs orig_ty is_dep cur_lvl bound dvs ty -- _ -> False -- -> return dv -- Skip inner skolems; ToDo: explain - | isConcreteTyVar tv - = return dv -- Never quantify over a "concrete" meta-tyvar (#23051) - | tv `elemDVarSet` kvs = return dv -- We have met this tyvar already @@ -1825,17 +1803,27 @@ defaultTyVar def_strat tv = do { traceTc "Defaulting a RuntimeRep var to LiftedRep" (ppr tv) ; writeMetaTyVar tv liftedRepTy ; return True } + | isLevityVar tv , default_ns_vars = do { traceTc "Defaulting a Levity var to Lifted" (ppr tv) ; writeMetaTyVar tv liftedDataConTy ; return True } + | isMultiplicityVar tv , default_ns_vars = do { traceTc "Defaulting a Multiplicity var to Many" (ppr tv) ; writeMetaTyVar tv manyDataConTy ; return True } + | isConcreteTyVar tv + -- We don't want to quantify; but neither can we default to anything + -- sensible. So we just promote. Not very satisfing, but it's very + -- much a corner case: #23051 + = do { lvl <- getTcLevel + ; _ <- promoteMetaTyVarTo lvl tv + ; return True } + | DefaultKindVars <- def_strat -- -XNoPolyKinds and this is a kind var: we must default it = default_kind_var tv @@ -1980,7 +1968,7 @@ What do do? D. We could error. We choose (D), as described in #17567, and implement this choice in -doNotQuantifyTyVars. Discussion of alternativs A-C is below. +doNotQuantifyTyVars. Discussion of alternatives A-C is below. NB: this is all rather similar to, but sadly not the same as Note [Naughty quantification candidates] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/386fbabc7f453bc23327d6f7e474d973aa0ef06e...1b10277a03196fbea62f2ca90106402c031f186c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/386fbabc7f453bc23327d6f7e474d973aa0ef06e...1b10277a03196fbea62f2ca90106402c031f186c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 13:00:53 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Tue, 07 Mar 2023 08:00:53 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T23083 Message-ID: <6407358590b7_2c78e92c5ebb01255b@gitlab.mail> Sebastian Graf pushed new branch wip/T23083 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23083 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 13:19:21 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Tue, 07 Mar 2023 08:19:21 -0500 Subject: [Git][ghc/ghc][wip/T20749] 2 commits: Simplifier: Eta expand arguments (#23083) Message-ID: <640739d9752ae_2c78e931a0a88131294@gitlab.mail> Sebastian Graf pushed to branch wip/T20749 at Glasgow Haskell Compiler / GHC Commits: 12c83c35 by Sebastian Graf at 2023-03-07T14:00:36+01:00 Simplifier: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` Tweaking the Simplifier to eta-expand in args was a bit more painful than expected: * `tryEtaExpandRhs` and `findRhsArity` previously only worked on bindings. But eta expansion of non-recursive bindings is morally the same as eta expansion of arguments. And in fact the binder was never really looked at in the non-recursive case. I was able to make `findRhsArity` cater for both arguments and bindings, as well as have a new function `tryEtaExpandArg` that shares most of its code with that of `tryEtaExpandRhs`. * The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`, which seems to be the main way to simplify args. Hence I consolidated the code path to call `simplArg`, too, renaming to `simplLazyArg`. Fixes #23083. - - - - - 964dbea3 by Sebastian Graf at 2023-03-07T14:18:43+01:00 Make DataCon workers strict in strict fields (#20749) This patch tweaks `exprIsConApp_maybe`, `exprIsHNF` and friends, and Demand Analysis so that they exploit and maintain strictness of DataCon workers. See `Note [Strict fields in Core]` for details. Very little needed to change, and it puts field seq insertion done by Tag Inference into a new perspective: That of *implementing* strict field semantics. Before Tag Inference, DataCon workers are strict. Afterwards they are effectively lazy and field seqs happen around use sites. History has shown that there is no other way to guarantee taggedness and thus the STG Strict Field Invariant. Knock-on changes: * `exprIsHNF` previously used `exprOkForSpeculation` on unlifted arguments instead of recursing into `exprIsHNF`. That regressed the termination analysis in CPR analysis (which simply calls out to `exprIsHNF`), so I made it call `exprOkForSpeculation`, too. * There's a small regression in Demand Analysis, visible in the changed test output of T16859: Previously, a field seq on a variable would give that variable a "used exactly once" demand, now it's "used at least once", because `dmdTransformDataConSig` accounts for future uses of the field that actually all go through the case binder (and hence won't re-enter the potential thunk). The difference should hardly be observable. * The Simplifier's fast path for data constructors only applies to lazy data constructors now. I observed regressions involving Data.Binary.Put's `Pair` data type. * Unfortunately, T21392 does no longer reproduce after this patch, so I marked it as "not broken" in order to track whether we regress again in the future. Fixes #20749, the satisfying conclusion of an annoying saga (cf. the ideas in #21497 and #22475). - - - - - 26 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Stats.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Misc.hs - testsuite/tests/simplCore/should_compile/T18013.stderr - + testsuite/tests/simplCore/should_compile/T23083.hs - + testsuite/tests/simplCore/should_compile/T23083.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/simplStg/should_compile/inferTags002.stderr - testsuite/tests/stranal/sigs/T16859.stderr Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -615,6 +615,8 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri -- See Note [Constructor tag allocation] and #14657 data_con = mkDataCon dc_name declared_infix prom_info (map (const no_bang) arg_tys) + (map (const HsLazy) arg_tys) + (map (const NotMarkedStrict) arg_tys) [] -- No labelled fields tyvars ex_tyvars (mkTyVarBinders SpecifiedSpec user_tyvars) ===================================== compiler/GHC/Core.hs ===================================== @@ -42,7 +42,7 @@ module GHC.Core ( foldBindersOfBindStrict, foldBindersOfBindsStrict, collectBinders, collectTyBinders, collectTyAndValBinders, collectNBinders, collectNValBinders_maybe, - collectArgs, stripNArgs, collectArgsTicks, flattenBinds, + collectArgs, collectValArgs, stripNArgs, collectArgsTicks, flattenBinds, collectFunSimple, exprToType, @@ -994,6 +994,60 @@ tail position: A cast changes the type, but the type must be the same. But operationally, casts are vacuous, so this is a bit unfortunate! See #14610 for ideas how to fix this. +Note [Strict fields in Core] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Evaluating a data constructor worker evaluates its strict fields. + +In other words, if `MkT` is strict in its first field and `xs` reduces to +`error "boom"`, then `MkT xs b` will throw that error. +Conversely, it is sound to seq the field before the call to the constructor, +e.g., with `case xs of xs' { __DEFAULT -> MkT xs' b }`. +Let's call this transformation "field seq insertion". + +Note in particular that the data constructor application `MkT xs b` above is +*not* a value, unless `xs` is! + +This has pervasive effect on the Core pipeline: + + * `exprIsHNF`/`exprIsConLike`/`exprOkForSpeculation` need to assert that the + strict arguments of a DataCon worker are values/ok-for-spec themselves. + + * `exprIsConApp_maybe` inserts field seqs in the `FloatBind`s it returns, so + that the Simplifier, Constant-folding, the pattern-match checker, etc. + all see the insert field seqs when they match on strict workers. Often this + is just to emphasise strict semantics, but for case-of-known constructor + and case-to-let field insertion is *vital*, otherwise these transformations + would lose field seqs. + + * The demand signature of a data constructor is strict in strict field + position, whereas is it's normally lazy. Likewise the demand *transformer* + of a DataCon worker can add stricten up demands on strict field args. + See Note [Demand transformer for data constructors]. + + * In the absence of `-fpedantic-bottoms`, it is still possible that some seqs + are ultimately dropped or delayed due to eta-expansion. + See Note [Dealing with bottom]. + +Strict field semantics is exploited in STG by Note [Tag Inference]: +It performs field seq insertion to statically guarantee *taggedness* of strict +fields, establishing the Note [STG Strict Field Invariant]. (Happily, most +of those seqs are immediately detected as redundant by tag inference and are +omitted.) From then on, DataCon worker semantics are actually lazy, hence it is +important that STG passes maintain the Strict Field Invariant. + + +Historical Note: +The delightfully simple description of strict field semantics is the result of +a long saga (#20749, the bits about strict data constructors in #21497, #22475), +where we tried a more lenient (but actually not) semantics first that would +allow both strict and lazy implementations of DataCon workers. This was favoured +because the "pervasive effect" throughout the compiler was deemed too large +(when it really turned out to be very modest). +Alas, this semantics would require us to implement `exprIsHNF` in *exactly* the +same way as above, otherwise the analysis would not be conservative wrt. the +lenient semantics (which includes the strict one). It is also much harder to +explain and maintain, as it turned out. + ************************************************************************ * * In/Out type synonyms @@ -2080,6 +2134,17 @@ collectArgs expr go (App f a) as = go f (a:as) go e as = (e, as) +-- | Takes a nested application expression and returns the function +-- being applied and the arguments to which it is applied +collectValArgs :: Expr b -> (Expr b, [Arg b]) +collectValArgs expr + = go expr [] + where + go (App f a) as + | isValArg a = go f (a:as) + | otherwise = go f as + go e as = (e, as) + -- | Takes a nested application expression and returns the function -- being applied. Looking through casts and ticks to find it. collectFunSimple :: Expr b -> Expr b ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -48,7 +48,8 @@ module GHC.Core.DataCon ( dataConIsInfix, dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitTyThings, - dataConRepStrictness, dataConImplBangs, dataConBoxer, + dataConRepStrictness, dataConRepStrictness_maybe, + dataConImplBangs, dataConBoxer, splitDataProductType_maybe, @@ -59,7 +60,7 @@ module GHC.Core.DataCon ( isVanillaDataCon, isNewDataCon, isTypeDataCon, classDataCon, dataConCannotMatch, dataConUserTyVarsNeedWrapper, checkDataConTyVars, - isBanged, isMarkedStrict, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked, + isBanged, isUnpacked, isMarkedStrict, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked, specialPromotedDc, -- ** Promotion related functions @@ -95,6 +96,7 @@ import GHC.Types.Unique.FM ( UniqFM ) import GHC.Types.Unique.Set import GHC.Builtin.Uniques( mkAlphaTyVarUnique ) import GHC.Data.Graph.UnVar -- UnVarSet and operations +import GHC.Data.Maybe (orElse) import GHC.Utils.Outputable import GHC.Utils.Misc @@ -502,6 +504,18 @@ data DataCon -- Matches 1-1 with dcOrigArgTys -- Hence length = dataConSourceArity dataCon + dcImplBangs :: [HsImplBang], + -- The actual decisions made (including failures) + -- about the original arguments; 1-1 with orig_arg_tys + -- See Note [Bangs on data constructor arguments] + + dcStricts :: [StrictnessMark], + -- One mark for every field of the DataCon worker; + -- if it's empty, then all fields are lazy, + -- otherwise it has the same length as dataConRepArgTys. + -- See also Note [Strict fields in Core] in GHC.Core + -- for the effect on the strictness signature + dcFields :: [FieldLabel], -- Field labels for this constructor, in the -- same order as the dcOrigArgTys; @@ -777,13 +791,6 @@ data DataConRep -- after unboxing and flattening, -- and *including* all evidence args - , dcr_stricts :: [StrictnessMark] -- 1-1 with dcr_arg_tys - -- See also Note [Data-con worker strictness] - - , dcr_bangs :: [HsImplBang] -- The actual decisions made (including failures) - -- about the original arguments; 1-1 with orig_arg_tys - -- See Note [Bangs on data constructor arguments] - } type DataConEnv a = UniqFM DataCon a -- Keyed by DataCon @@ -852,43 +859,8 @@ eqSpecPreds spec = [ mkPrimEqPred (mkTyVarTy tv) ty instance Outputable EqSpec where ppr (EqSpec tv ty) = ppr (tv, ty) -{- Note [Data-con worker strictness] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Notice that we do *not* say the worker Id is strict even if the data -constructor is declared strict - e.g. data T = MkT ![Int] Bool -Even though most often the evals are done by the *wrapper* $WMkT, there are -situations in which tag inference will re-insert evals around the worker. -So for all intents and purposes the *worker* MkT is strict, too! - -Unfortunately, if we exposed accurate strictness of DataCon workers, we'd -see the following transformation: - - f xs = case xs of xs' { __DEFAULT -> ... case MkT xs b of x { __DEFAULT -> [x] } } -- DmdAnal: Strict in xs - ==> { drop-seq, binder swap on xs' } - f xs = case MkT xs b of x { __DEFAULT -> [x] } -- DmdAnal: Still strict in xs - ==> { case-to-let } - f xs = let x = MkT xs' b in [x] -- DmdAnal: No longer strict in xs! - -I.e., we are ironically losing strictness in `xs` by dropping the eval on `xs` -and then doing case-to-let. The issue is that `exprIsHNF` currently says that -every DataCon worker app is a value. The implicit assumption is that surrounding -evals will have evaluated strict fields like `xs` before! But now that we had -just dropped the eval on `xs`, that assumption is no longer valid. - -Long story short: By keeping the demand signature lazy, the Simplifier will not -drop the eval on `xs` and using `exprIsHNF` to decide case-to-let and others -remains sound. - -Similarly, during demand analysis in dmdTransformDataConSig, we bump up the -field demand with `C_01`, *not* `C_11`, because the latter exposes too much -strictness that will drop the eval on `xs` above. - -This issue is discussed at length in -"Failed idea: no wrappers for strict data constructors" in #21497 and #22475. - -Note [Bangs on data constructor arguments] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Bangs on data constructor arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data T = MkT !Int {-# UNPACK #-} !Int Bool @@ -914,8 +886,8 @@ Terminology: the flag settings in the importing module. Also see Note [Bangs on imported data constructors] in GHC.Types.Id.Make -* The dcr_bangs field of the dcRep field records the [HsImplBang] - If T was defined in this module, Without -O the dcr_bangs might be +* The dcImplBangs field records the [HsImplBang] + If T was defined in this module, Without -O the dcImplBangs might be [HsStrict _, HsStrict _, HsLazy] With -O it might be [HsStrict _, HsUnpack _, HsLazy] @@ -959,6 +931,17 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. +* Core passes will often need to know whether the DataCon worker or wrapper in + an application is strict in some (lifted) field or not. This is tracked in the + demand signature attached to a DataCon's worker resp. wrapper Id. + + So if you've got a DataCon dc, you can get the demand signature by + `idDmdSig (dataConWorkId dc)` and make out strict args by testing with + `isStrictDmd`. Similarly, `idDmdSig <$> dataConWrapId_maybe dc` gives + you the demand signature of the wrapper, if it exists. + + These demand signatures are set in GHC.Types.Id.Make. + Note [Data con representation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The dcRepType field contains the type of the representation of a constructor @@ -974,14 +957,14 @@ what it means is the DataCon with all Unpacking having been applied. We can think of this as the Core representation. Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# + data Ord a => T a = MkT !Int a Void# Here T :: Ord a => Int -> a -> Void# -> T a but the rep type is Trep :: Int# -> a -> Void# -> T a Actually, the unboxed part isn't implemented yet! -Not that this representation is still *different* from runtime +Note that this representation is still *different* from runtime representation. (Which is what STG uses after unarise). This is how T would end up being used in STG post-unarise: @@ -1106,6 +1089,11 @@ isBanged (HsUnpack {}) = True isBanged (HsStrict {}) = True isBanged HsLazy = False +isUnpacked :: HsImplBang -> Bool +isUnpacked (HsUnpack {}) = True +isUnpacked (HsStrict {}) = False +isUnpacked HsLazy = False + isSrcStrict :: SrcStrictness -> Bool isSrcStrict SrcStrict = True isSrcStrict _ = False @@ -1131,13 +1119,15 @@ cbvFromStrictMark MarkedStrict = MarkedCbv -- | Build a new data constructor mkDataCon :: Name - -> Bool -- ^ Is the constructor declared infix? - -> TyConRepName -- ^ TyConRepName for the promoted TyCon - -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user - -> [FieldLabel] -- ^ Field labels for the constructor, - -- if it is a record, otherwise empty - -> [TyVar] -- ^ Universals. - -> [TyCoVar] -- ^ Existentials. + -> Bool -- ^ Is the constructor declared infix? + -> TyConRepName -- ^ TyConRepName for the promoted TyCon + -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user + -> [HsImplBang] -- ^ Strictness/unpack annotations, as inferred by the compiler + -> [StrictnessMark] -- ^ Strictness marks for the DataCon worker's fields in Core + -> [FieldLabel] -- ^ Field labels for the constructor, + -- if it is a record, otherwise empty + -> [TyVar] -- ^ Universals. + -> [TyCoVar] -- ^ Existentials. -> [InvisTVBinder] -- ^ User-written 'TyVarBinder's. -- These must be Inferred/Specified. -- See @Note [TyVarBinders in DataCons]@ @@ -1156,7 +1146,9 @@ mkDataCon :: Name -- Can get the tag from the TyCon mkDataCon name declared_infix prom_info - arg_stricts -- Must match orig_arg_tys 1-1 + arg_stricts -- Must match orig_arg_tys 1-1 + impl_bangs -- Must match orig_arg_tys 1-1 + str_marks -- Must be empty or match dataConRepArgTys 1-1 fields univ_tvs ex_tvs user_tvbs eq_spec theta @@ -1173,6 +1165,8 @@ mkDataCon name declared_infix prom_info = con where is_vanilla = null ex_tvs && null eq_spec && null theta + str_marks' | not $ any isMarkedStrict str_marks = [] + | otherwise = str_marks con = MkData {dcName = name, dcUnique = nameUnique name, dcVanilla = is_vanilla, dcInfix = declared_infix, @@ -1184,7 +1178,8 @@ mkDataCon name declared_infix prom_info dcStupidTheta = stupid_theta, dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty, dcRepTyCon = rep_tycon, - dcSrcBangs = arg_stricts, + dcSrcBangs = arg_stricts, dcImplBangs = impl_bangs, + dcStricts = str_marks', dcFields = fields, dcTag = tag, dcRepType = rep_ty, dcWorkId = work_id, dcRep = rep, @@ -1412,19 +1407,27 @@ isNullaryRepDataCon :: DataCon -> Bool isNullaryRepDataCon dc = dataConRepArity dc == 0 dataConRepStrictness :: DataCon -> [StrictnessMark] --- ^ Give the demands on the arguments of a --- Core constructor application (Con dc args) -dataConRepStrictness dc = case dcRep dc of - NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc] - DCR { dcr_stricts = strs } -> strs +-- ^ Give the demands on the runtime arguments of a Core DataCon worker +-- application. +-- The length of the list matches `dataConRepArgTys` (e.g., the number +-- of runtime arguments). +dataConRepStrictness dc + = dataConRepStrictness_maybe dc + `orElse` map (const NotMarkedStrict) (dataConRepArgTys dc) + +dataConRepStrictness_maybe :: DataCon -> Maybe [StrictnessMark] +-- ^ Give the demands on the runtime arguments of a Core DataCon worker +-- application or `Nothing` if all of them are lazy. +-- The length of the list matches `dataConRepArgTys` (e.g., the number +-- of runtime arguments). +dataConRepStrictness_maybe dc + | null (dcStricts dc) = Nothing + | otherwise = Just (dcStricts dc) dataConImplBangs :: DataCon -> [HsImplBang] -- The implementation decisions about the strictness/unpack of each -- source program argument to the data constructor -dataConImplBangs dc - = case dcRep dc of - NoDataConRep -> replicate (dcSourceArity dc) HsLazy - DCR { dcr_bangs = bangs } -> bangs +dataConImplBangs dc = dcImplBangs dc dataConBoxer :: DataCon -> Maybe DataConBoxer dataConBoxer (MkData { dcRep = DCR { dcr_boxer = boxer } }) = Just boxer ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -872,9 +872,16 @@ exprEtaExpandArity opts e * * ********************************************************************* -} -findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr - -> (Bool, SafeArityType) --- This implements the fixpoint loop for arity analysis +findRhsArity + :: ArityOpts + -> Maybe Id -- ^ `Just bndr` when it's a recursive RHS bound by bndr + -> Bool -- ^ Is it a join binding? + -> [OneShotInfo] -- ^ The one-shot info from the use sites, perhaps from + -- `idDemandOneShots` of the binder + -> CoreExpr -- ^ The RHS (or argument expression) + -> Type -- ^ Type of the CoreExpr + -> (Bool, SafeArityType) +-- ^ This implements the fixpoint loop for arity analysis -- See Note [Arity analysis] -- -- The Bool is True if the returned arity is greater than (exprArity rhs) @@ -884,8 +891,8 @@ findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr -- Returns an SafeArityType that is guaranteed trimmed to typeArity of 'bndr' -- See Note [Arity trimming] -findRhsArity opts is_rec bndr rhs - | isJoinId bndr +findRhsArity opts mb_rec_bndr is_join use_one_shots rhs rhs_ty + | is_join = (False, join_arity_type) -- False: see Note [Do not eta-expand join points] -- But do return the correct arity and bottom-ness, because @@ -900,28 +907,27 @@ findRhsArity opts is_rec bndr rhs old_arity = exprArity rhs init_env :: ArityEnv - init_env = findRhsArityEnv opts (isJoinId bndr) + init_env = findRhsArityEnv opts is_join -- Non-join-points only - non_join_arity_type = case is_rec of - Recursive -> go 0 botArityType - NonRecursive -> step init_env + non_join_arity_type = case mb_rec_bndr of + Just bndr -> go 0 bndr botArityType + Nothing -> step init_env arity_increased = arityTypeArity non_join_arity_type > old_arity -- Join-points only -- See Note [Arity for non-recursive join bindings] -- and Note [Arity for recursive join bindings] - join_arity_type = case is_rec of - Recursive -> go 0 botArityType - NonRecursive -> trimArityType ty_arity (cheapArityType rhs) + join_arity_type = case mb_rec_bndr of + Just bndr -> go 0 bndr botArityType + Nothing -> trimArityType ty_arity (cheapArityType rhs) - ty_arity = typeArity (idType bndr) - id_one_shots = idDemandOneShots bndr + ty_arity = typeArity rhs_ty step :: ArityEnv -> SafeArityType step env = trimArityType ty_arity $ safeArityType $ -- See Note [Arity invariants for bindings], item (3) - arityType env rhs `combineWithDemandOneShots` id_one_shots + arityType env rhs `combineWithDemandOneShots` use_one_shots -- trimArityType: see Note [Trim arity inside the loop] -- combineWithDemandOneShots: take account of the demand on the -- binder. Perhaps it is always called with 2 args @@ -934,8 +940,8 @@ findRhsArity opts is_rec bndr rhs -- is assumed to be sound. In other words, arities should never -- decrease. Result: the common case is that there is just one -- iteration - go :: Int -> SafeArityType -> SafeArityType - go !n cur_at@(AT lams div) + go :: Int -> Id -> SafeArityType -> SafeArityType + go !n bndr cur_at@(AT lams div) | not (isDeadEndDiv div) -- the "stop right away" case , length lams <= old_arity = cur_at -- from above | next_at == cur_at = cur_at @@ -944,7 +950,7 @@ findRhsArity opts is_rec bndr rhs = warnPprTrace (debugIsOn && n > 2) "Exciting arity" (nest 2 (ppr bndr <+> ppr cur_at <+> ppr next_at $$ ppr rhs)) $ - go (n+1) next_at + go (n+1) bndr next_at where next_at = step (extendSigEnv init_env bndr cur_at) @@ -964,30 +970,6 @@ combineWithDemandOneShots at@(AT lams div) oss zip_lams ((ch,os1):lams) (os2:oss) = (ch, os1 `bestOneShot` os2) : zip_lams lams oss -idDemandOneShots :: Id -> [OneShotInfo] -idDemandOneShots bndr - = call_arity_one_shots `zip_lams` dmd_one_shots - where - call_arity_one_shots :: [OneShotInfo] - call_arity_one_shots - | call_arity == 0 = [] - | otherwise = NoOneShotInfo : replicate (call_arity-1) OneShotLam - -- Call Arity analysis says the function is always called - -- applied to this many arguments. The first NoOneShotInfo is because - -- if Call Arity says "always applied to 3 args" then the one-shot info - -- we get is [NoOneShotInfo, OneShotLam, OneShotLam] - call_arity = idCallArity bndr - - dmd_one_shots :: [OneShotInfo] - -- If the demand info is C(x,C(1,C(1,.))) then we know that an - -- application to one arg is also an application to three - dmd_one_shots = argOneShots (idDemandInfo bndr) - - -- Take the *longer* list - zip_lams (lam1:lams1) (lam2:lams2) = (lam1 `bestOneShot` lam2) : zip_lams lams1 lams2 - zip_lams [] lams2 = lams2 - zip_lams lams1 [] = lams1 - {- Note [Arity analysis] ~~~~~~~~~~~~~~~~~~~~~~~~ The motivating example for arity analysis is this: @@ -1461,7 +1443,7 @@ myExprIsCheap (AE { am_opts = opts, am_sigs = sigs }) e mb_ty -- See Note [Eta expanding through dictionaries] -- See Note [Eta expanding through CallStacks] - cheap_fun e = exprIsCheapX (myIsCheapApp sigs) e + cheap_fun e = exprIsCheapX (myIsCheapApp sigs) False e -- | A version of 'isCheapApp' that considers results from arity analysis. -- See Note [Arity analysis] for what's in the signature environment and why ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -46,7 +46,7 @@ import GHC.Core import GHC.Core.Make import GHC.Core.SimpleOpt ( exprIsConApp_maybe, exprIsLiteral_maybe ) import GHC.Core.DataCon ( DataCon,dataConTagZ, dataConTyCon, dataConWrapId, dataConWorkId ) -import GHC.Core.Utils ( cheapEqExpr, exprIsHNF +import GHC.Core.Utils ( cheapEqExpr, exprOkForSpeculation , stripTicksTop, stripTicksTopT, mkTicks ) import GHC.Core.Multiplicity import GHC.Core.Rules.Config @@ -1936,7 +1936,7 @@ Things to note Implementing seq#. The compiler has magic for SeqOp in -- GHC.Core.Opt.ConstantFold.seqRule: eliminate (seq# s) +- GHC.Core.Opt.ConstantFold.seqRule: eliminate (seq# s) - GHC.StgToCmm.Expr.cgExpr, and cgCase: special case for seq# @@ -1951,7 +1951,7 @@ Implementing seq#. The compiler has magic for SeqOp in seqRule :: RuleM CoreExpr seqRule = do [Type _ty_a, Type _ty_s, a, s] <- getArgs - guard $ exprIsHNF a + guard $ exprOkForSpeculation a return $ mkCoreUnboxedTuple [s, a] -- spark# :: forall a s . a -> State# s -> (# State# s, a #) ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -297,9 +297,16 @@ data TermFlag -- Better than using a Bool -- See Note [Nested CPR] exprTerminates :: CoreExpr -> TermFlag +-- ^ A /very/ simple termination analysis. exprTerminates e - | exprIsHNF e = Terminates -- A /very/ simple termination analysis. - | otherwise = MightDiverge + | exprIsHNF e = Terminates + | exprOkForSpeculation e = Terminates + | otherwise = MightDiverge + -- Annyingly, we have to check both for HNF and ok-for-spec. + -- * `I# (x# *# 2#)` is ok-for-spec, but not in HNF. Still worth CPR'ing! + -- * `lvl` is an HNF if its unfolding is evaluated + -- (perhaps `lvl = I# 0#` at top-level). But, tiresomely, it is never + -- ok-for-spec due to Note [exprOkForSpeculation and evaluated variables]. cprAnalApp :: AnalEnv -> CoreExpr -> [(CprType, CoreArg)] -> (CprType, CoreExpr) -- Main function that takes care of /nested/ CPR. See Note [Nested CPR] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -814,6 +814,10 @@ to the Divergence lattice, but in practice it turned out to be hard to untaint from 'topDiv' to 'conDiv', leading to bugs, performance regressions and complexity that didn't justify the single fixed testcase T13380c. +You might think that we should check for side-effects rather than just for +precise exceptions. Right you are! See Note [Side-effects and strictness] +for why we unfortunately do not. + Note [Demand analysis for recursive data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ T11545 features a single-product, recursive data type ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -8,14 +8,13 @@ module GHC.Core.Opt.Simplify.Env ( -- * The simplifier mode - SimplMode(..), updMode, - smPedanticBottoms, smPlatform, + SimplMode(..), updMode, smPlatform, -- * Environments SimplEnv(..), pprSimplEnv, -- Temp not abstract seArityOpts, seCaseCase, seCaseFolding, seCaseMerge, seCastSwizzle, seDoEtaReduction, seEtaExpand, seFloatEnable, seInline, seNames, - seOptCoercionOpts, sePedanticBottoms, sePhase, sePlatform, sePreInline, + seOptCoercionOpts, sePhase, sePlatform, sePreInline, seRuleOpts, seRules, seUnfoldingOpts, mkSimplEnv, extendIdSubst, extendTvSubst, extendCvSubst, @@ -216,9 +215,6 @@ seNames env = sm_names (seMode env) seOptCoercionOpts :: SimplEnv -> OptCoercionOpts seOptCoercionOpts env = sm_co_opt_opts (seMode env) -sePedanticBottoms :: SimplEnv -> Bool -sePedanticBottoms env = smPedanticBottoms (seMode env) - sePhase :: SimplEnv -> CompilerPhase sePhase env = sm_phase (seMode env) @@ -273,9 +269,6 @@ instance Outputable SimplMode where where pp_flag f s = ppUnless f (text "no") <+> s -smPedanticBottoms :: SimplMode -> Bool -smPedanticBottoms opts = ao_ped_bot (sm_arity_opts opts) - smPlatform :: SimplMode -> Platform smPlatform opts = roPlatform (sm_rule_opts opts) ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -32,7 +32,7 @@ import GHC.Core.Reduction import GHC.Core.Coercion.Opt ( optCoercion ) import GHC.Core.FamInstEnv ( FamInstEnv, topNormaliseType_maybe ) import GHC.Core.DataCon - ( DataCon, dataConWorkId, dataConRepStrictness + ( DataCon, dataConWorkId, dataConRepStrictness, dataConRepStrictness_maybe , dataConRepArgTys, isUnboxedTupleDataCon , StrictnessMark (..) ) import GHC.Core.Opt.Stats ( Tick(..) ) @@ -1517,7 +1517,7 @@ rebuild env expr cont ApplyToVal { sc_arg = arg, sc_env = se, sc_dup = dup_flag , sc_cont = cont, sc_hole_ty = fun_ty } -- See Note [Avoid redundant simplification] - -> do { (_, _, arg') <- simplArg env dup_flag fun_ty se arg + -> do { (_, _, arg') <- simplLazyArg env dup_flag fun_ty Nothing topDmd se arg ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv @@ -1633,7 +1633,6 @@ simplCast env body co0 cont0 , sc_hole_ty = coercionLKind co }) } -- NB! As the cast goes past, the -- type of the hole changes (#16312) - -- (f |> co) e ===> (f (e |> co1)) |> co2 -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 @@ -1652,7 +1651,7 @@ simplCast env body co0 cont0 -- See Note [Avoiding exponential behaviour] MCo co1 -> - do { (dup', arg_se', arg') <- simplArg env dup fun_ty arg_se arg + do { (dup', arg_se', arg') <- simplLazyArg env dup fun_ty Nothing topDmd arg_se arg -- When we build the ApplyTo we can't mix the OutCoercion -- 'co' with the InExpr 'arg', so we simplify -- to make it all consistent. It's a bit messy. @@ -1678,17 +1677,21 @@ simplCast env body co0 cont0 -- See Note [Representation polymorphism invariants] in GHC.Core -- test: typecheck/should_run/EtaExpandLevPoly -simplArg :: SimplEnv -> DupFlag - -> OutType -- Type of the function applied to this arg - -> StaticEnv -> CoreExpr -- Expression with its static envt - -> SimplM (DupFlag, StaticEnv, OutExpr) -simplArg env dup_flag fun_ty arg_env arg +simplLazyArg :: SimplEnv -> DupFlag + -> OutType -- Type of the function applied to this arg + -> Maybe ArgInfo + -> Demand -- Demand on the argument expr + -> StaticEnv -> CoreExpr -- Expression with its static envt + -> SimplM (DupFlag, StaticEnv, OutExpr) +simplLazyArg env dup_flag fun_ty mb_arg_info arg_dmd arg_env arg | isSimplified dup_flag = return (dup_flag, arg_env, arg) | otherwise = do { let arg_env' = arg_env `setInScopeFromE` env - ; arg' <- simplExprC arg_env' arg (mkBoringStop (funArgTy fun_ty)) - ; return (Simplified, zapSubstEnv arg_env', arg') } + ; let arg_ty = funArgTy fun_ty + ; arg1 <- simplExprC arg_env' arg (mkLazyArgStop arg_ty mb_arg_info) + ; (_arity_type, arg2) <- tryEtaExpandArg env arg_dmd arg1 arg_ty + ; return (Simplified, zapSubstEnv arg_env', arg2) } -- Return a StaticEnv that includes the in-scope set from 'env', -- because arg' may well mention those variables (#20639) @@ -2091,14 +2094,14 @@ zap the SubstEnv. This is VITAL. Consider We'll clone the inner \x, adding x->x' in the id_subst Then when we inline y, we must *not* replace x by x' in the inlined copy!! -Note [Fast path for data constructors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Fast path for lazy data constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For applications of a data constructor worker, the full glory of rebuildCall is a waste of effort; * They never inline, obviously * They have no rewrite rules -* They are not strict (see Note [Data-con worker strictness] - in GHC.Core.DataCon) +* Though they might be strict (see Note [Strict fields in Core] in GHC.Core), + we will exploit that strictness through their demand signature So it's fine to zoom straight to `rebuild` which just rebuilds the call in a very straightforward way. @@ -2122,7 +2125,8 @@ simplVar env var simplIdF :: SimplEnv -> InId -> SimplCont -> SimplM (SimplFloats, OutExpr) simplIdF env var cont - | isDataConWorkId var -- See Note [Fast path for data constructors] + | Just dc <- isDataConWorkId_maybe var -- See Note [Fast path for lazy data constructors] + , Nothing <- dataConRepStrictness_maybe dc = rebuild env (Var var) cont | otherwise = case substId env var of @@ -2281,12 +2285,9 @@ rebuildCall env fun_info -- There is no benefit (unlike in a let-binding), and we'd -- have to be very careful about bogus strictness through -- floating a demanded let. - = do { arg' <- simplExprC (arg_se `setInScopeFromE` env) arg - (mkLazyArgStop arg_ty fun_info) + = do { let (dmd:_) = ai_dmds fun_info + ; (_, _, arg') <- simplLazyArg env dup_flag fun_ty (Just fun_info) dmd arg_se arg ; rebuildCall env (addValArgTo fun_info arg' fun_ty) cont } - where - arg_ty = funArgTy fun_ty - ---------- No further useful info, revert to generic rebuild ------------ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont @@ -3304,7 +3305,7 @@ a case pattern. This is *important*. Consider We really must record that b is already evaluated so that we don't go and re-evaluate it when constructing the result. -See Note [Data-con worker strictness] in GHC.Core.DataCon +See Note [Strict fields in Core] in GHC.Core. NB: simplLamBndrs preserves this eval info @@ -3723,7 +3724,7 @@ mkDupableContWithDmds env dmds do { let (dmd:cont_dmds) = dmds -- Never fails ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 - ; (_, se', arg') <- simplArg env' dup hole_ty se arg + ; (_, se', arg') <- simplLazyArg env' dup hole_ty Nothing dmd se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ; let all_floats = floats1 `addLetFloats` let_floats2 ; return ( all_floats ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -9,7 +9,7 @@ The simplifier utilities module GHC.Core.Opt.Simplify.Utils ( -- Rebuilding rebuildLam, mkCase, prepareAlts, - tryEtaExpandRhs, wantEtaExpansion, + tryEtaExpandRhs, tryEtaExpandArg, wantEtaExpansion, -- Inlining, preInlineUnconditionally, postInlineUnconditionally, @@ -461,8 +461,9 @@ mkRhsStop :: OutType -> RecFlag -> Demand -> SimplCont -- See Note [RHS of lets] in GHC.Core.Unfold mkRhsStop ty is_rec bndr_dmd = Stop ty (RhsCtxt is_rec) (subDemandIfEvaluated bndr_dmd) -mkLazyArgStop :: OutType -> ArgInfo -> SimplCont -mkLazyArgStop ty fun_info = Stop ty (lazyArgContext fun_info) arg_sd +mkLazyArgStop :: OutType -> Maybe ArgInfo -> SimplCont +mkLazyArgStop ty Nothing = mkBoringStop ty +mkLazyArgStop ty (Just fun_info) = Stop ty (lazyArgContext fun_info) arg_sd where arg_sd = subDemandIfEvaluated (Partial.head (ai_dmds fun_info)) @@ -1738,7 +1739,7 @@ rebuildLam env bndrs@(bndr:_) body cont , seEtaExpand env , any isRuntimeVar bndrs -- Only when there is at least one value lambda already , Just body_arity <- exprEtaExpandArity (seArityOpts env) body - = do { tick (EtaExpansion bndr) + = do { tick (EtaExpansion Nothing) ; let body' = etaExpandAT in_scope body_arity body ; traceSmpl "eta expand" (vcat [text "before" <+> ppr body , text "after" <+> ppr body']) @@ -1859,25 +1860,48 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpandRhs env bind_cxt bndr rhs + = tryEtaExpandArgOrRhs env mb_rec_bndr (isJoinBC bind_cxt) + (idDemandOneShots bndr) rhs (idType bndr) + where + mb_rec_bndr = case bindContextRec bind_cxt of + Recursive -> Just bndr + NonRecursive -> Nothing + +tryEtaExpandArg :: SimplEnv -> Demand -> OutExpr -> OutType + -> SimplM (ArityType, OutExpr) +-- See Note [Eta-expanding at let bindings] +tryEtaExpandArg env arg_dmd arg arg_ty + = tryEtaExpandArgOrRhs env Nothing False (argOneShots arg_dmd) arg arg_ty + +tryEtaExpandArgOrRhs + :: SimplEnv + -> Maybe OutId -- ^ `Just bndr` when it's a recursive RHS bound by bndr + -> Bool -- ^ Is it a join binding? + -> [OneShotInfo] -- ^ The one-shot info from the use sites, perhaps from + -- `idDemandOneShots` of the binder + -> OutExpr -- ^ The RHS (or argument expression) + -> OutType -- ^ Type of the CoreExpr + -> SimplM (ArityType, OutExpr) +-- See Note [Eta-expanding at let bindings] +tryEtaExpandArgOrRhs env mb_rec_bndr is_join use_one_shots rhs rhs_ty | do_eta_expand -- If the current manifest arity isn't enough -- (never true for join points) , seEtaExpand env -- and eta-expansion is on , wantEtaExpansion rhs = -- Do eta-expansion. - assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ + assertPpr( not is_join ) (ppr mb_rec_bndr) $ -- assert: this never happens for join points; see GHC.Core.Opt.Arity -- Note [Do not eta-expand join points] - do { tick (EtaExpansion bndr) + do { tick (EtaExpansion mb_rec_bndr) ; return (arity_type, etaExpandAT in_scope arity_type rhs) } | otherwise - = return (arity_type, rhs) + = pprTrace "tryEtaExpandArgOrRhs" (ppr mb_rec_bndr $$ ppr arity_type $$ ppr rhs) $ return (arity_type, rhs) where in_scope = getInScope env arity_opts = seArityOpts env - is_rec = bindContextRec bind_cxt - (do_eta_expand, arity_type) = findRhsArity arity_opts is_rec bndr rhs + (do_eta_expand, arity_type) = findRhsArity arity_opts mb_rec_bndr is_join use_one_shots rhs rhs_ty wantEtaExpansion :: CoreExpr -> Bool -- Mostly True; but False of PAPs which will immediately eta-reduce again @@ -1890,6 +1914,30 @@ wantEtaExpansion (Var {}) = False wantEtaExpansion (Lit {}) = False wantEtaExpansion _ = True +idDemandOneShots :: Id -> [OneShotInfo] +idDemandOneShots bndr + = call_arity_one_shots `zip_lams` dmd_one_shots + where + call_arity_one_shots :: [OneShotInfo] + call_arity_one_shots + | call_arity == 0 = [] + | otherwise = NoOneShotInfo : replicate (call_arity-1) OneShotLam + -- Call Arity analysis says the function is always called + -- applied to this many arguments. The first NoOneShotInfo is because + -- if Call Arity says "always applied to 3 args" then the one-shot info + -- we get is [NoOneShotInfo, OneShotLam, OneShotLam] + call_arity = idCallArity bndr + + dmd_one_shots :: [OneShotInfo] + -- If the demand info is C(x,C(1,C(1,.))) then we know that an + -- application to one arg is also an application to three + dmd_one_shots = argOneShots (idDemandInfo bndr) + + -- Take the *longer* list + zip_lams (lam1:lams1) (lam2:lams2) = (lam1 `bestOneShot` lam2) : zip_lams lams1 lams2 + zip_lams [] lams2 = lams2 + zip_lams lams1 [] = lams1 + {- Note [Eta-expanding at let bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Stats.hs ===================================== @@ -226,7 +226,7 @@ data Tick -- See Note [Which transformations are innocuous] | RuleFired FastString -- Rule name | LetFloatFromLet - | EtaExpansion Id -- LHS binder + | EtaExpansion (Maybe Id) -- LHS binder, if recursive | EtaReduction Id -- Binder on outer lambda | BetaReduction Id -- Lambda binder ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -1219,11 +1219,8 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr -- simplifier produces rhs[exp/a], changing semantics if exp is not ok-for-spec -- Good: returning (Mk#, [x]) with a float of case exp of x { DEFAULT -> [] } -- simplifier produces case exp of a { DEFAULT -> exp[x/a] } - = let arg' = subst_expr subst arg - bndr = uniqAway (subst_in_scope subst) (mkWildValBinder ManyTy arg_type) - float = FloatCase arg' bndr DEFAULT [] - subst' = subst_extend_in_scope subst bndr - in go subst' (float:floats) fun (CC (Var bndr : args) co) + , (subst', float, bndr) <- case_bind subst arg arg_type + = go subst' (float:floats) fun (CC (Var bndr : args) co) | otherwise = go subst floats fun (CC (subst_expr subst arg : args) co) @@ -1262,8 +1259,9 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr | Just con <- isDataConWorkId_maybe fun , count isValArg args == idArity fun - = succeedWith in_scope floats $ - pushCoDataCon con args co + , (in_scope', seq_floats, args') <- mkFieldSeqFloats in_scope con args + = succeedWith in_scope' (seq_floats ++ floats) $ + pushCoDataCon con args' co -- Look through data constructor wrappers: they inline late (See Note -- [Activation for data constructor wrappers]) but we want to do @@ -1349,6 +1347,36 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr extend (Left in_scope) v e = Right (extendSubst (mkEmptySubst in_scope) v e) extend (Right s) v e = Right (extendSubst s v e) + case_bind :: Either InScopeSet Subst -> CoreExpr -> Type -> (Either InScopeSet Subst, FloatBind, Id) + case_bind subst expr expr_ty = (subst', float, bndr) + where + bndr = setCaseBndrEvald MarkedStrict $ + uniqAway (subst_in_scope subst) $ + mkWildValBinder ManyTy expr_ty + subst' = subst_extend_in_scope subst bndr + expr' = subst_expr subst expr + float = FloatCase expr' bndr DEFAULT [] + + mkFieldSeqFloats :: InScopeSet -> DataCon -> [CoreExpr] -> (InScopeSet, [FloatBind], [CoreExpr]) + mkFieldSeqFloats in_scope dc args + | Nothing <- dataConRepStrictness_maybe dc + = (in_scope, [], args) + | otherwise + = (in_scope', floats', ty_args ++ val_args') + where + (ty_args, val_args) = splitAtList (dataConUnivAndExTyCoVars dc) args + (in_scope', floats', val_args') = foldr do_one (in_scope, [], []) $ zipEqual "mkFieldSeqFloats" str_marks val_args + str_marks = dataConRepStrictness dc + do_one (str, arg) (in_scope,floats,args) + | NotMarkedStrict <- str = (in_scope, floats, arg:args) + | Var v <- arg, is_evald v = (in_scope, floats, arg:args) + | otherwise = (in_scope', float:floats, Var bndr:args) + where + is_evald v = isId v && isEvaldUnfolding (idUnfolding v) + (in_scope', float, bndr) = + case case_bind (Left in_scope) arg (exprType arg) of + (Left in_scope', float, bndr) -> (in_scope', float, bndr) + (right, _, _) -> pprPanic "case_bind did not preserve Left" (ppr in_scope $$ ppr arg $$ ppr right) -- See Note [exprIsConApp_maybe on literal strings] dealWithStringLiteral :: Var -> BS.ByteString -> Coercion ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1252,18 +1252,23 @@ in this (which it previously was): in \w. v True -} --------------------- -exprIsWorkFree :: CoreExpr -> Bool -- See Note [exprIsWorkFree] -exprIsWorkFree e = exprIsCheapX isWorkFreeApp e - -exprIsCheap :: CoreExpr -> Bool -exprIsCheap e = exprIsCheapX isCheapApp e +------------------------------------- +type CheapAppFun = Id -> Arity -> Bool + -- Is an application of this function to n *value* args + -- always cheap, assuming the arguments are cheap? + -- True mainly of data constructors, partial applications; + -- but with minor variations: + -- isWorkFreeApp + -- isCheapApp + -- isExpandableApp -exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool +exprIsCheapX :: CheapAppFun -> Bool -> CoreExpr -> Bool {-# INLINE exprIsCheapX #-} --- allow specialization of exprIsCheap and exprIsWorkFree +-- allow specialization of exprIsCheap, exprIsWorkFree and exprIsExpandable -- instead of having an unknown call to ok_app -exprIsCheapX ok_app e +-- expandable: Only True for exprIsExpandable, where Case and Let are never +-- expandable. +exprIsCheapX ok_app expandable e = ok e where ok e = go 0 e @@ -1274,98 +1279,34 @@ exprIsCheapX ok_app e go _ (Type {}) = True go _ (Coercion {}) = True go n (Cast e _) = go n e - go n (Case scrut _ _ alts) = ok scrut && - and [ go n rhs | Alt _ _ rhs <- alts ] go n (Tick t e) | tickishCounts t = False | otherwise = go n e go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e | otherwise = go n e go n (App f e) | isRuntimeArg e = go (n+1) f && ok e | otherwise = go n f - go n (Let (NonRec _ r) e) = go n e && ok r - go n (Let (Rec prs) e) = go n e && all (ok . snd) prs + go n (Case scrut _ _ alts) = not expandable && ok scrut && + and [ go n rhs | Alt _ _ rhs <- alts ] + go n (Let (NonRec _ r) e) = not expandable && go n e && ok r + go n (Let (Rec prs) e) = not expandable && go n e && all (ok . snd) prs -- Case: see Note [Case expressions are work-free] -- App, Let: see Note [Arguments and let-bindings exprIsCheapX] +-------------------- +exprIsWorkFree :: CoreExpr -> Bool +-- See Note [exprIsWorkFree] +exprIsWorkFree e = exprIsCheapX isWorkFreeApp False e -{- Note [exprIsExpandable] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -An expression is "expandable" if we are willing to duplicate it, if doing -so might make a RULE or case-of-constructor fire. Consider - let x = (a,b) - y = build g - in ....(case x of (p,q) -> rhs)....(foldr k z y).... - -We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold), -but we do want - - * the case-expression to simplify - (via exprIsConApp_maybe, exprIsLiteral_maybe) - - * the foldr/build RULE to fire - (by expanding the unfolding during rule matching) - -So we classify the unfolding of a let-binding as "expandable" (via the -uf_expandable field) if we want to do this kind of on-the-fly -expansion. Specifically: - -* True of constructor applications (K a b) - -* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic. - (NB: exprIsCheap might not be true of this) - -* False of case-expressions. If we have - let x = case ... in ...(case x of ...)... - we won't simplify. We have to inline x. See #14688. - -* False of let-expressions (same reason); and in any case we - float lets out of an RHS if doing so will reveal an expandable - application (see SimplEnv.doFloatFromRhs). - -* Take care: exprIsExpandable should /not/ be true of primops. I - found this in test T5623a: - let q = /\a. Ptr a (a +# b) - in case q @ Float of Ptr v -> ...q... - - q's inlining should not be expandable, else exprIsConApp_maybe will - say that (q @ Float) expands to (Ptr a (a +# b)), and that will - duplicate the (a +# b) primop, which we should not do lightly. - (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) --} +-------------------- +exprIsCheap :: CoreExpr -> Bool +-- See Note [exprIsCheap] +exprIsCheap e = exprIsCheapX isCheapApp False e -------------------------------------- +-------------------- exprIsExpandable :: CoreExpr -> Bool -- See Note [exprIsExpandable] -exprIsExpandable e - = ok e - where - ok e = go 0 e - - -- n is the number of value arguments - go n (Var v) = isExpandableApp v n - go _ (Lit {}) = True - go _ (Type {}) = True - go _ (Coercion {}) = True - go n (Cast e _) = go n e - go n (Tick t e) | tickishCounts t = False - | otherwise = go n e - go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e - | otherwise = go n e - go n (App f e) | isRuntimeArg e = go (n+1) f && ok e - | otherwise = go n f - go _ (Case {}) = False - go _ (Let {}) = False - - -------------------------------------- -type CheapAppFun = Id -> Arity -> Bool - -- Is an application of this function to n *value* args - -- always cheap, assuming the arguments are cheap? - -- True mainly of data constructors, partial applications; - -- but with minor variations: - -- isWorkFreeApp - -- isCheapApp +exprIsExpandable e = exprIsCheapX isExpandableApp True e isWorkFreeApp :: CheapAppFun isWorkFreeApp fn n_val_args @@ -1384,7 +1325,7 @@ isCheapApp fn n_val_args | isDeadEndId fn = True -- See Note [isCheapApp: bottoming functions] | otherwise = case idDetails fn of - DataConWorkId {} -> True -- Actually handled by isWorkFreeApp + -- DataConWorkId {} -> _ -- Handled by isWorkFreeApp RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId op _ -> primOpIsCheap op @@ -1399,6 +1340,7 @@ isExpandableApp fn n_val_args | isWorkFreeApp fn n_val_args = True | otherwise = case idDetails fn of + -- DataConWorkId {} -> _ -- Handled by isWorkFreeApp RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId {} -> False @@ -1430,6 +1372,50 @@ isExpandableApp fn n_val_args I'm not sure why we have a special case for bottoming functions in isCheapApp. Maybe we don't need it. +Note [exprIsExpandable] +~~~~~~~~~~~~~~~~~~~~~~~ +An expression is "expandable" if we are willing to duplicate it, if doing +so might make a RULE or case-of-constructor fire. Consider + let x = (a,b) + y = build g + in ....(case x of (p,q) -> rhs)....(foldr k z y).... + +We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold), +but we do want + + * the case-expression to simplify + (via exprIsConApp_maybe, exprIsLiteral_maybe) + + * the foldr/build RULE to fire + (by expanding the unfolding during rule matching) + +So we classify the unfolding of a let-binding as "expandable" (via the +uf_expandable field) if we want to do this kind of on-the-fly +expansion. Specifically: + +* True of constructor applications (K a b) + +* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic. + (NB: exprIsCheap might not be true of this) + +* False of case-expressions. If we have + let x = case ... in ...(case x of ...)... + we won't simplify. We have to inline x. See #14688. + +* False of let-expressions (same reason); and in any case we + float lets out of an RHS if doing so will reveal an expandable + application (see SimplEnv.doFloatFromRhs). + +* Take care: exprIsExpandable should /not/ be true of primops. I + found this in test T5623a: + let q = /\a. Ptr a (a +# b) + in case q @ Float of Ptr v -> ...q... + + q's inlining should not be expandable, else exprIsConApp_maybe will + say that (q @ Float) expands to (Ptr a (a +# b)), and that will + duplicate the (a +# b) primop, which we should not do lightly. + (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) + Note [isExpandableApp: bottoming functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important that isExpandableApp does not respond True to bottoming @@ -1573,10 +1559,10 @@ expr_ok fun_ok primop_ok (Case scrut bndr _ alts) && altsAreExhaustive alts expr_ok fun_ok primop_ok other_expr - | (expr, args) <- collectArgs other_expr + | (expr, val_args) <- collectValArgs other_expr = case stripTicksTopE (not . tickishCounts) expr of Var f -> - app_ok fun_ok primop_ok f args + app_ok fun_ok primop_ok f val_args -- 'LitRubbish' is the only literal that can occur in the head of an -- application and will not be matched by the above case (Var /= Lit). @@ -1590,8 +1576,8 @@ expr_ok fun_ok primop_ok other_expr _ -> False ----------------------------- -app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool -app_ok fun_ok primop_ok fun args +app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreArg] -> Bool +app_ok fun_ok primop_ok fun val_args | not (fun_ok fun) = False -- This code path is only taken for Note [Speculative evaluation] | otherwise @@ -1600,21 +1586,22 @@ app_ok fun_ok primop_ok fun args -- DFuns terminate, unless the dict is implemented -- with a newtype in which case they may not - DataConWorkId {} -> True - -- The strictness of the constructor has already - -- been expressed by its "wrapper", so we don't need - -- to take the arguments into account + DataConWorkId dc + | Just str_marks <- dataConRepStrictness_maybe dc + -> all3Prefix field_ok str_marks val_arg_tys val_args + | otherwise + -> all2Prefix arg_ok val_arg_tys val_args ClassOpId _ is_terminating_result | is_terminating_result -- See Note [exprOkForSpeculation and type classes] - -> assertPpr (n_val_args == 1) (ppr fun $$ ppr args) $ + -> assertPpr (n_val_args == 1) (ppr fun $$ ppr val_args) $ True -- assert: terminating result type => can't be applied; -- c.f the _other case below PrimOpId op _ | primOpIsDiv op - , [arg1, Lit lit] <- args + , [arg1, Lit lit] <- val_args -> not (isZeroLit lit) && expr_ok fun_ok primop_ok arg1 -- Special case for dividing operations that fail -- In general they are NOT ok-for-speculation @@ -1632,13 +1619,13 @@ app_ok fun_ok primop_ok fun args | otherwise -> primop_ok op -- Check the primop itself - && and (zipWith arg_ok arg_tys args) -- Check the arguments + && all2Prefix arg_ok val_arg_tys val_args -- Check the arguments _other -- Unlifted and terminating types; -- Also c.f. the Var case of exprIsHNF | isTerminatingType fun_ty -- See Note [exprOkForSpeculation and type classes] || definitelyUnliftedType fun_ty - -> assertPpr (n_val_args == 0) (ppr fun $$ ppr args) + -> assertPpr (n_val_args == 0) (ppr fun $$ ppr val_args) True -- Both terminating types (e.g. Eq a), and unlifted types (e.g. Int#) -- are non-functions and so will have no value args. The assert is -- just to check this. @@ -1647,7 +1634,7 @@ app_ok fun_ok primop_ok fun args -- Partial applications | idArity fun > n_val_args -> - and (zipWith arg_ok arg_tys args) -- Check the arguments + all2Prefix arg_ok val_arg_tys val_args -- Check the arguments -- Functions that terminate fast without raising exceptions etc -- See Note [Discarding unnecessary unsafeEqualityProofs] @@ -1659,18 +1646,27 @@ app_ok fun_ok primop_ok fun args -- see Note [exprOkForSpeculation and evaluated variables] where fun_ty = idType fun - n_val_args = valArgCount args + n_val_args = length val_args (arg_tys, _) = splitPiTys fun_ty + val_arg_tys = mapMaybe anonPiTyBinderType_maybe arg_tys -- Used for arguments to primops and to partial applications - arg_ok :: PiTyVarBinder -> CoreExpr -> Bool - arg_ok (Named _) _ = True -- A type argument - arg_ok (Anon ty _) arg -- A term argument - | definitelyLiftedType (scaledThing ty) + arg_ok :: Type -> CoreExpr -> Bool + arg_ok ty arg + | definitelyLiftedType ty = True -- See Note [Primops with lifted arguments] | otherwise = expr_ok fun_ok primop_ok arg + -- Used for DataCon worker arguments + field_ok :: StrictnessMark -> Type -> CoreExpr -> Bool + field_ok str ty arg -- A term argument + | NotMarkedStrict <- str -- iff it's a lazy field + , definitelyLiftedType ty -- and its type is lifted + = True -- then the worker app does not eval + | otherwise + = expr_ok fun_ok primop_ok arg + ----------------------------- altsAreExhaustive :: [Alt b] -> Bool -- True <=> the case alternatives are definitely exhaustive @@ -1937,12 +1933,14 @@ exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding -- or PAPs. -- exprIsHNFlike :: HasDebugCallStack => (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool -exprIsHNFlike is_con is_con_unf = is_hnf_like +exprIsHNFlike is_con is_con_unf e + = -- pprTraceWith "hnf" (\r -> ppr r <+> ppr e) $ + is_hnf_like e where is_hnf_like (Var v) -- NB: There are no value args at this point - = id_app_is_value v 0 -- Catches nullary constructors, - -- so that [] and () are values, for example - -- and (e.g.) primops that don't have unfoldings + = id_app_is_value v [] -- Catches nullary constructors, + -- so that [] and () are values, for example + -- and (e.g.) primops that don't have unfoldings || is_con_unf (idUnfolding v) -- Check the thing's unfolding; it might be bound to a value -- or to a guaranteed-evaluated variable (isEvaldUnfolding) @@ -1966,31 +1964,57 @@ exprIsHNFlike is_con is_con_unf = is_hnf_like -- See Note [exprIsHNF Tick] is_hnf_like (Cast e _) = is_hnf_like e is_hnf_like (App e a) - | isValArg a = app_is_value e 1 + | isValArg a = app_is_value e [a] | otherwise = is_hnf_like e is_hnf_like (Let _ e) = is_hnf_like e -- Lazy let(rec)s don't affect us is_hnf_like _ = False - -- 'n' is the number of value args to which the expression is applied - -- And n>0: there is at least one value argument - app_is_value :: CoreExpr -> Int -> Bool - app_is_value (Var f) nva = id_app_is_value f nva - app_is_value (Tick _ f) nva = app_is_value f nva - app_is_value (Cast f _) nva = app_is_value f nva - app_is_value (App f a) nva - | isValArg a = - app_is_value f (nva + 1) && - not (needsCaseBinding (exprType a) a) - -- For example f (x /# y) where f has arity two, and the first - -- argument is unboxed. This is not a value! - -- But f 34# is a value. - -- NB: Check app_is_value first, the arity check is cheaper - | otherwise = app_is_value f nva - app_is_value _ _ = False - - id_app_is_value id n_val_args - = is_con id - || idArity id > n_val_args + -- Collect arguments through Casts and Ticks and call id_app_is_value + app_is_value :: CoreExpr -> [CoreArg] -> Bool + app_is_value (Var f) as = id_app_is_value f as + app_is_value (Tick _ f) as = app_is_value f as + app_is_value (Cast f _) as = app_is_value f as + app_is_value (App f a) as | isValArg a = app_is_value f (a:as) + | otherwise = app_is_value f as + app_is_value _ _ = False + + id_app_is_value id val_args + -- First handle saturated applications of DataCons with strict fields + | Just dc <- isDataConWorkId_maybe id -- DataCon + , Just str_marks <- dataConRepStrictness_maybe dc -- with strict fields + , assert (val_args `leLength` str_marks) True + , val_args `equalLength` str_marks -- in a saturated app + = all3Prefix check_field str_marks val_arg_tys val_args + + -- Now all applications except saturated DataCon apps with strict fields + | idArity id > length val_args + -- PAP: Check unlifted val_args + || is_con id && isNothing (isDataConWorkId_maybe id >>= dataConRepStrictness_maybe) + -- Either a lazy DataCon or a CONLIKE. + -- Hence we only need to check unlifted val_args here. + -- NB: We assume that CONLIKEs are lazy, which is their entire + -- point. + = all2Prefix check_arg val_arg_tys val_args + + | otherwise + = False + where + fun_ty = idType id + (arg_tys,_) = splitPiTys fun_ty + val_arg_tys = mapMaybe anonPiTyBinderType_maybe arg_tys + -- val_arg_tys = map exprType val_args, but much less costly. + -- The obvious definition regresses T16577 by 30% so we don't do it. + + check_arg a_ty a = mightBeUnliftedType a_ty ==> is_hnf_like a + -- Check unliftedness; for example f (x /# 12#) where f has arity two, + -- and the first argument is unboxed. This is not a value! + -- But f 34# is a value, so check args for HNFs. + -- NB: We check arity (and CONLIKEness) first because it's cheaper + -- and we reject quickly on saturated apps. + check_field str a_ty a + = isMarkedStrict str || mightBeUnliftedType a_ty ==> is_hnf_like a + a ==> b = not a || b + infixr 1 ==> {- Note [exprIsHNF Tick] @@ -2551,7 +2575,7 @@ This means the seqs on x and y both become no-ops and compared to the first vers The downside is that the caller of $wfoo potentially has to evaluate `y` once if we can't prove it isn't already evaluated. But y coming out of a strict field is in WHNF so safe to evaluated. And most of the time it will be properly tagged+evaluated -already at the call site because of the Strict Field Invariant! See Note [Strict Field Invariant] for more in this. +already at the call site because of the Strict Field Invariant! See Note [STG Strict Field Invariant] for more in this. This makes GHC itself around 1% faster despite doing slightly more work! So this is generally quite good. We only apply this when we think there is a benefit in doing so however. There are a number of cases in which ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -64,8 +64,8 @@ With nofib being ~0.3% faster as well. See Note [Tag inference passes] for how we proceed to generate and use this information. -Note [Strict Field Invariant] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [STG Strict Field Invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As part of tag inference we introduce the Strict Field Invariant. Which consists of us saying that: @@ -124,15 +124,33 @@ Note that there are similar constraints around Note [CBV Function Ids]. Note [How untagged pointers can end up in strict fields] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Since the resolution of #20749 where Core passes assume that DataCon workers +evaluate their strict fields, it is pretty simple to see how the Simplifier +might exploit that knowledge to drop evals. Example: + + data MkT a = MkT !a + f :: [Int] -> T [Int] + f xs = xs `seq` MkT xs + +in Core we will have + + f = \xs -> MkT @[Int] xs + +No eval left there. + Consider data Set a = Tip | Bin !a (Set a) (Set a) We make a wrapper for Bin that evaluates its arguments $WBin x a b = case x of xv -> Bin xv a b Here `xv` will always be evaluated and properly tagged, just as the -Strict Field Invariant requires. +Note [STG Strict Field Invariant] requires. + +But alas, the Simplifier can destroy the invariant: see #15696. +Indeed, as Note [Strict fields in Core] explains, Core passes +assume that Data constructor workers evaluate their strict fields, +so the Simplifier will drop seqs freely. -But alas the Simplifier can destroy the invariant: see #15696. We start with thk = f () g x = ...(case thk of xv -> Bin xv Tip Tip)... @@ -153,7 +171,7 @@ Now you can see that the argument of Bin, namely thk, points to the thunk, not to the value as it did before. In short, although it may be rare, the output of optimisation passes -cannot guarantee to obey the Strict Field Invariant. For this reason +cannot guarantee to obey the Note [STG Strict Field Invariant]. For this reason we run tag inference. See Note [Tag inference passes]. Note [Tag inference passes] @@ -163,7 +181,7 @@ Tag inference proceeds in two passes: The result is then attached to /binders/. This is implemented by `inferTagsAnal` in GHC.Stg.InferTags * The second pass walks over the AST checking if the Strict Field Invariant is upheld. - See Note [Strict Field Invariant]. + See Note [STG Strict Field Invariant]. If required this pass modifies the program to uphold this invariant. Tag information is also moved from /binders/ to /occurrences/ during this pass. This is done by `GHC.Stg.InferTags.Rewrite (rewriteTopBinds)`. ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -64,7 +64,7 @@ The work of this pass is simple: * For any strict field we check if the argument is known to be properly tagged. * If it's not known to be properly tagged, we wrap the whole thing in a case, which will force the argument before allocation. -This is described in detail in Note [Strict Field Invariant]. +This is described in detail in Note [STG Strict Field Invariant]. The only slight complication is that we have to make sure not to invalidate free variable analysis in the process. @@ -217,7 +217,7 @@ When compiling bytecode we call myCoreToStg to get STG code first. myCoreToStg in turn calls out to stg2stg which runs the STG to STG passes followed by free variables analysis and the tag inference pass including it's rewriting phase at the end. -Running tag inference is important as it upholds Note [Strict Field Invariant]. +Running tag inference is important as it upholds Note [STG Strict Field Invariant]. While code executed by GHCi doesn't take advantage of the SFI it can call into compiled code which does. So it must still make sure that the SFI is upheld. See also #21083 and #22042. ===================================== compiler/GHC/Tc/TyCl/Build.hs ===================================== @@ -176,12 +176,13 @@ buildDataCon fam_envs dc_bang_opts src_name declared_infix prom_info src_bangs tag = lookupNameEnv_NF tag_map src_name -- See Note [Constructor tag allocation], fixes #14657 data_con = mkDataCon src_name declared_infix prom_info - src_bangs field_lbls + src_bangs impl_bangs str_marks field_lbls univ_tvs ex_tvs user_tvbs eq_spec ctxt arg_tys res_ty NoPromInfo rep_tycon tag stupid_ctxt dc_wrk dc_rep dc_wrk = mkDataConWorkId work_name data_con - dc_rep = initUs_ us (mkDataConRep dc_bang_opts fam_envs wrap_name data_con) + (dc_rep, impl_bangs, str_marks) = + initUs_ us (mkDataConRep dc_bang_opts fam_envs wrap_name data_con) ; traceIf (text "buildDataCon 2" <+> ppr src_name) ; return data_con } ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -1390,33 +1390,8 @@ arguments. That is the job of dmdTransformDataConSig. More precisely, * it returns the demands on the arguments; in the above example that is [SL, A] -Nasty wrinkle. Consider this code (#22475 has more realistic examples but -assume this is what the demand analyser sees) - - data T = MkT !Int Bool - get :: T -> Bool - get (MkT _ b) = b - - foo = let v::Int = I# 7 - t::T = MkT v True - in get t - -Now `v` is unused by `get`, /but/ we can't give `v` an Absent demand, -else we'll drop the binding and replace it with an error thunk. -Then the code generator (more specifically GHC.Stg.InferTags.Rewrite) -will add an extra eval of MkT's argument to give - foo = let v::Int = error "absent" - t::T = case v of v' -> MkT v' True - in get t - -Boo! Because of this extra eval (added in STG-land), the truth is that `MkT` -may (or may not) evaluate its arguments (as established in #21497). Hence the -use of `bump` in dmdTransformDataConSig, which adds in a `C_01` eval. The -`C_01` says "may or may not evaluate" which is absolutely faithful to what -InferTags.Rewrite does. - -In particular it is very important /not/ to make that a `C_11` eval, -see Note [Data-con worker strictness]. +When the data constructor worker has strict fields, they act as additional +seqs; hence we add an additional `C_11` eval. -} {- ********************************************************************* @@ -1616,6 +1591,29 @@ a bad fit because expression may not throw a precise exception (increasing precision of the analysis), but that's just a favourable guess. +Note [Side-effects and strictness] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Due to historic reasons and the continued effort not to cause performance +regressions downstream, Strictness Analysis is currently prone to discarding +observable side-effects (other than precise exceptions, see +Note [Precise exceptions and strictness analysis]) in some cases. For example, + f :: MVar () -> Int -> IO Int + f mv x = putMVar mv () >> (x `seq` return x) +The call to `putMVar` is an observable side-effect. Yet, Strictness Analysis +currently concludes that `f` is strict in `x` and uses call-by-value. +That means `f mv (error "boom")` will error out with the imprecise exception +rather performing the side-effect. + +This is a conscious violation of the semantics described in the paper +"a semantics for imprecise exceptions"; so it would be great if we could +identify the offending primops and extend the idea in +Note [Which scrutinees may throw precise exceptions] to general side-effects. + +Unfortunately, the existing has-side-effects classification for primops is +too conservative, listing `writeMutVar#` and even `readMutVar#` as +side-effecting. That is due to #3207. A possible way forward is described in +#17900, but no effort has been so far towards a resolution. + Note [Exceptions and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We used to smart about catching exceptions, but we aren't anymore. @@ -2326,7 +2324,7 @@ dmdTransformDataConSig str_marks sd = case viewProd arity body_sd of mk_body_ty n dmds = DmdType emptyDmdEnv (zipWith (bump n) str_marks dmds) topDiv bump n str dmd | isMarkedStrict str = multDmd n (plusDmd str_field_dmd dmd) | otherwise = multDmd n dmd - str_field_dmd = C_01 :* seqSubDmd -- Why not C_11? See Note [Data-con worker strictness] + str_field_dmd = C_11 :* seqSubDmd -- See Note [Strict fields in Core] -- | A special 'DmdTransformer' for dictionary selectors that feeds the demand -- on the result into the indicated dictionary component (if saturated). ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -220,7 +220,7 @@ The invariants around the arguments of call by value function like Ids are then: * Any `WorkerLikeId` * Some `JoinId` bindings. -This works analogous to the Strict Field Invariant. See also Note [Strict Field Invariant]. +This works analogous to the Strict Field Invariant. See also Note [STG Strict Field Invariant]. To make this work what we do is: * During W/W and SpecConstr any worker/specialized binding we introduce ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -56,7 +56,7 @@ import GHC.Core.Coercion import GHC.Core.Reduction import GHC.Core.Make import GHC.Core.FVs ( mkRuleInfo ) -import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, coreAltsType ) +import GHC.Core.Utils ( exprType, mkCast, coreAltsType ) import GHC.Core.Unfold.Make import GHC.Core.SimpleOpt import GHC.Core.TyCon @@ -586,8 +586,12 @@ mkDataConWorkId wkr_name data_con = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info where - tycon = dataConTyCon data_con -- The representation TyCon - wkr_ty = dataConRepType data_con + tycon = dataConTyCon data_con -- The representation TyCon + wkr_ty = dataConRepType data_con + univ_tvs = dataConUnivTyVars data_con + ex_tcvs = dataConExTyCoVars data_con + arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys + str_marks = dataConRepStrictness data_con ----------- Workers for data types -------------- alg_wkr_info = noCafIdInfo @@ -595,15 +599,19 @@ mkDataConWorkId wkr_name data_con `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 - -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon + `setDmdSigInfo` wkr_sig + -- Workers eval their strict fields + -- See Note [Strict fields in Core] wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + wkr_sig = mkClosedDmdSig wkr_dmds topDiv + wkr_dmds = map mk_dmd str_marks + mk_dmd MarkedStrict = evalDmd + mk_dmd NotMarkedStrict = topDmd + ----------- Workers for newtypes -------------- - univ_tvs = dataConUnivTyVars data_con - ex_tcvs = dataConExTyCoVars data_con - arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` dataConWrapperInlinePragma @@ -686,10 +694,10 @@ mkDataConRep :: DataConBangOpts -> FamInstEnvs -> Name -> DataCon - -> UniqSM DataConRep + -> UniqSM (DataConRep, [HsImplBang], [StrictnessMark]) mkDataConRep dc_bang_opts fam_envs wrap_name data_con | not wrapper_reqd - = return NoDataConRep + = return (NoDataConRep, arg_ibangs, rep_strs) | otherwise = do { wrap_args <- mapM (newLocal (fsLit "conrep")) wrap_arg_tys @@ -744,11 +752,8 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con ; return (DCR { dcr_wrap_id = wrap_id , dcr_boxer = mk_boxer boxers - , dcr_arg_tys = rep_tys - , dcr_stricts = rep_strs - -- For newtypes, dcr_bangs is always [HsLazy]. - -- See Note [HsImplBangs for newtypes]. - , dcr_bangs = arg_ibangs }) } + , dcr_arg_tys = rep_tys } + , arg_ibangs, rep_strs) } where (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty) @@ -798,8 +803,8 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con -- (Most) newtypes have only a worker, with the exception -- of some newtypes written with GADT syntax. -- See dataConUserTyVarsNeedWrapper below. - && (any isBanged (ev_ibangs ++ arg_ibangs))) - -- Some forcing/unboxing (includes eq_spec) + && (any isUnpacked (ev_ibangs ++ arg_ibangs))) + -- Some unboxing (includes eq_spec) || isFamInstTyCon tycon -- Cast result || (dataConUserTyVarsNeedWrapper data_con -- If the data type was written with GADT syntax and @@ -1077,7 +1082,7 @@ dataConArgRep arg_ty HsLazy = ([(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer)) dataConArgRep arg_ty (HsStrict _) - = ([(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer)) + = ([(arg_ty, MarkedStrict)], (unitUnboxer, unitBoxer)) -- Seqs are inserted in STG dataConArgRep arg_ty (HsUnpack Nothing) = dataConArgUnpack arg_ty @@ -1107,9 +1112,6 @@ wrapCo co rep_ty (unbox_rep, box_rep) -- co :: arg_ty ~ rep_ty ; return (rep_ids, rep_expr `Cast` mkSymCo sco) } ------------------------ -seqUnboxer :: Unboxer -seqUnboxer v = return ([v], mkDefaultCase (Var v) v) - unitUnboxer :: Unboxer unitUnboxer v = return ([v], \e -> e) ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Utils.Misc ( dropWhileEndLE, spanEnd, last2, lastMaybe, onJust, - List.foldl1', foldl2, count, countWhile, all2, + List.foldl1', foldl2, count, countWhile, all2, all2Prefix, all3Prefix, lengthExceeds, lengthIs, lengthIsNot, lengthAtLeast, lengthAtMost, lengthLessThan, @@ -646,6 +646,25 @@ all2 _ [] [] = True all2 p (x:xs) (y:ys) = p x y && all2 p xs ys all2 _ _ _ = False +all2Prefix :: (a -> b -> Bool) -> [a] -> [b] -> Bool +-- ^ `all2Prefix p xs ys` is a fused version of `and $ zipWith2 p xs ys`. +-- So if one list is shorter than the other, `p` is assumed to be `True` for the +-- suffix. +all2Prefix p xs ys = go xs ys + where go (x:xs) (y:ys) = p x y && go xs ys + go _ _ = True +{-# INLINABLE all2Prefix #-} + +all3Prefix :: (a -> b -> c -> Bool) -> [a] -> [b] -> [c] -> Bool +-- ^ `all3Prefix p xs ys zs` is a fused version of `and $ zipWith3 p xs ys zs`. +-- So if one list is shorter than the others, `p` is assumed to be `True` for +-- the suffix. +all3Prefix p xs ys zs = go xs ys zs + where + go (x:xs) (y:ys) (z:zs) = p x y z && go xs ys zs + go _ _ _ = True +{-# INLINABLE all3Prefix #-} + -- Count the number of times a predicate is true count :: (a -> Bool) -> [a] -> Int ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -17,6 +17,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: Class op . (BUILTIN) @@ -25,6 +27,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Arrow (BUILTIN) Rule fired: Class op $p1Arrow (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) @@ -38,6 +42,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op first (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op >>= (BUILTIN) @@ -48,6 +54,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @(_, ()) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: Class op . (BUILTIN) @@ -56,6 +64,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op . (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op $p1Applicative (BUILTIN) @@ -70,6 +80,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Arrow (BUILTIN) Rule fired: Class op $p1Arrow (BUILTIN) Rule fired: Class op id (BUILTIN) @@ -83,6 +95,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op ||| (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op $p1Applicative (BUILTIN) @@ -98,6 +112,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: Class op . (BUILTIN) @@ -108,22 +124,6 @@ Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: mkRule @((), _) (T18013a) Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @(_, ()) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) Rule fired: mkRule @(_, ()) (T18013a) Rule fired: Class op fmap (BUILTIN) Rule fired: mkRule @(_, ()) (T18013a) @@ -138,9 +138,9 @@ mapMaybeRule [InlPrag=[2]] :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, Arity=1, - Str=<1!P(L,LC(S,C(1,C(1,P(L,1L)))))>, - Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, + Str=<1!P(SL,LC(S,C(1,C(1,P(L,1L)))))>, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@b) (f [Occ=Once1!] :: Rule IO a b) -> case f of { Rule @s ww ww1 [Occ=OnceL1!] -> @@ -219,36 +219,41 @@ mapMaybeRule -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18013.$trModule4 :: GHC.Prim.Addr# [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 20 0}] T18013.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T18013.$trModule3 :: GHC.Types.TrName [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T18013.$trModule3 = GHC.Types.TrNameS T18013.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18013.$trModule2 :: GHC.Prim.Addr# [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 30 0}] T18013.$trModule2 = "T18013"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T18013.$trModule1 :: GHC.Types.TrName [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T18013.$trModule1 = GHC.Types.TrNameS T18013.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T18013.$trModule :: GHC.Types.Module [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T18013.$trModule = GHC.Types.Module T18013.$trModule3 T18013.$trModule1 ===================================== testsuite/tests/simplCore/should_compile/T23083.hs ===================================== @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +module T23083 where + +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +g f h = f (h `seq` (h $)) ===================================== testsuite/tests/simplCore/should_compile/T23083.stderr ===================================== @@ -0,0 +1,36 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 21, types: 17, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 6, types: 6, coercions: 0, joins: 0/0} +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +[GblId, Arity=2, Str=<1C(1,L)>, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60] 50 0}] +g = \ (f :: (Integer -> Integer) -> Integer) (h :: Integer -> Integer) -> f (\ (eta :: Integer) -> h eta) + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule4 :: GHC.Prim.Addr# +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T23083.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule3 :: GHC.Types.TrName +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule3 = GHC.Types.TrNameS T23083.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule2 :: GHC.Prim.Addr# +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T23083.$trModule2 = "T23083"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule1 :: GHC.Types.TrName +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule1 = GHC.Types.TrNameS T23083.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule :: GHC.Types.Module +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule = GHC.Types.Module T23083.$trModule3 T23083.$trModule1 + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -417,7 +417,10 @@ test('T21391', normal, compile, ['-O -dcore-lint']) test('T22112', normal, compile, ['-O -dsuppress-uniques -dno-typeable-binds -ddump-simpl']) test('T21391a', normal, compile, ['-O -dcore-lint']) # We don't want to see a thunk allocation for the insertBy expression after CorePrep. -test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]'), expect_broken(21392) ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques']) +# Unfortunately, this test is no longer broken after we made workers strict in strict fields, +# so it is no longer a reproducer for T21392. Still, it doesn't hurt if we test that we don't +# regress again. +test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]') ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques']) test('T21689', [extra_files(['T21689a.hs'])], multimod_compile, ['T21689', '-v0 -O']) test('T21801', normal, compile, ['-O -dcore-lint']) test('T21848', [grep_errmsg(r'SPEC wombat') ], compile, ['-O -ddump-spec']) @@ -476,3 +479,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) +test('T23083', [ grep_errmsg(r'f.*eta') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dppr-cols=99999']) ===================================== testsuite/tests/simplStg/should_compile/inferTags002.stderr ===================================== @@ -1,88 +1,30 @@ -==================== Output Cmm ==================== -[M.$WMkT_entry() { // [R3, R2] - { info_tbls: [(cym, - label: block_cym_info - rep: StackRep [False] - srt: Nothing), - (cyp, - label: M.$WMkT_info - rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 15} } - srt: Nothing), - (cys, - label: block_cys_info - rep: StackRep [False] - srt: Nothing)] - stack_info: arg_space: 8 - } - {offset - cyp: // global - if ((Sp + -16) < SpLim) (likely: False) goto cyv; else goto cyw; - cyv: // global - R1 = M.$WMkT_closure; - call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8; - cyw: // global - I64[Sp - 16] = cym; - R1 = R2; - P64[Sp - 8] = R3; - Sp = Sp - 16; - if (R1 & 7 != 0) goto cym; else goto cyn; - cyn: // global - call (I64[R1])(R1) returns to cym, args: 8, res: 8, upd: 8; - cym: // global - I64[Sp] = cys; - _sy8::P64 = R1; - R1 = P64[Sp + 8]; - P64[Sp + 8] = _sy8::P64; - call stg_ap_0_fast(R1) returns to cys, args: 8, res: 8, upd: 8; - cys: // global - Hp = Hp + 24; - if (Hp > HpLim) (likely: False) goto cyA; else goto cyz; - cyA: // global - HpAlloc = 24; - call stg_gc_unpt_r1(R1) returns to cys, args: 8, res: 8, upd: 8; - cyz: // global - I64[Hp - 16] = M.MkT_con_info; - P64[Hp - 8] = P64[Sp + 8]; - P64[Hp] = R1; - R1 = Hp - 15; - Sp = Sp + 16; - call (P64[Sp])(R1) args: 8, res: 0, upd: 8; - } - }, - section ""data" . M.$WMkT_closure" { - M.$WMkT_closure: - const M.$WMkT_info; - }] - - - ==================== Output Cmm ==================== [M.f_entry() { // [R2] - { info_tbls: [(cyK, - label: block_cyK_info + { info_tbls: [(cAs, + label: block_info rep: StackRep [] srt: Nothing), - (cyN, + (cAv, label: M.f_info rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} } srt: Nothing)] stack_info: arg_space: 8 } {offset - cyN: // global - if ((Sp + -8) < SpLim) (likely: False) goto cyO; else goto cyP; - cyO: // global + _lbl_: // global + if ((Sp + -8) < SpLim) (likely: False) goto cAw; else goto cAx; + _lbl_: // global R1 = M.f_closure; call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; - cyP: // global - I64[Sp - 8] = cyK; + _lbl_: // global + I64[Sp - 8] = cAs; R1 = R2; Sp = Sp - 8; - if (R1 & 7 != 0) goto cyK; else goto cyL; - cyL: // global - call (I64[R1])(R1) returns to cyK, args: 8, res: 8, upd: 8; - cyK: // global + if (R1 & 7 != 0) goto cAs; else goto cAt; + _lbl_: // global + call (I64[R1])(R1) returns to cAs, args: 8, res: 8, upd: 8; + _lbl_: // global R1 = P64[R1 + 15]; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; @@ -97,47 +39,47 @@ ==================== Output Cmm ==================== [M.MkT_entry() { // [R3, R2] - { info_tbls: [(cz1, - label: block_cz1_info + { info_tbls: [(cAJ, + label: block_info rep: StackRep [False] srt: Nothing), - (cz4, + (cAM, label: M.MkT_info rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 15} } srt: Nothing), - (cz7, - label: block_cz7_info + (cAP, + label: block_info rep: StackRep [False] srt: Nothing)] stack_info: arg_space: 8 } {offset - cz4: // global - if ((Sp + -16) < SpLim) (likely: False) goto cza; else goto czb; - cza: // global + _lbl_: // global + if ((Sp + -16) < SpLim) (likely: False) goto cAS; else goto cAT; + _lbl_: // global R1 = M.MkT_closure; call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8; - czb: // global - I64[Sp - 16] = cz1; + _lbl_: // global + I64[Sp - 16] = cAJ; R1 = R2; P64[Sp - 8] = R3; Sp = Sp - 16; - if (R1 & 7 != 0) goto cz1; else goto cz2; - cz2: // global - call (I64[R1])(R1) returns to cz1, args: 8, res: 8, upd: 8; - cz1: // global - I64[Sp] = cz7; - _tyf::P64 = R1; + if (R1 & 7 != 0) goto cAJ; else goto cAK; + _lbl_: // global + call (I64[R1])(R1) returns to cAJ, args: 8, res: 8, upd: 8; + _lbl_: // global + I64[Sp] = cAP; + __locVar_::P64 = R1; R1 = P64[Sp + 8]; - P64[Sp + 8] = _tyf::P64; - call stg_ap_0_fast(R1) returns to cz7, args: 8, res: 8, upd: 8; - cz7: // global + P64[Sp + 8] = __locVar_::P64; + call stg_ap_0_fast(R1) returns to cAP, args: 8, res: 8, upd: 8; + _lbl_: // global Hp = Hp + 24; - if (Hp > HpLim) (likely: False) goto czf; else goto cze; - czf: // global + if (Hp > HpLim) (likely: False) goto cAX; else goto cAW; + _lbl_: // global HpAlloc = 24; - call stg_gc_unpt_r1(R1) returns to cz7, args: 8, res: 8, upd: 8; - cze: // global + call stg_gc_unpt_r1(R1) returns to cAP, args: 8, res: 8, upd: 8; + _lbl_: // global I64[Hp - 16] = M.MkT_con_info; P64[Hp - 8] = P64[Sp + 8]; P64[Hp] = R1; @@ -155,14 +97,14 @@ ==================== Output Cmm ==================== [M.MkT_con_entry() { // [] - { info_tbls: [(czl, + { info_tbls: [(cB3, label: M.MkT_con_info rep: HeapRep 2 ptrs { Con {tag: 0 descr:"main:M.MkT"} } srt: Nothing)] stack_info: arg_space: 8 } {offset - czl: // global + _lbl_: // global R1 = R1 + 1; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; } ===================================== testsuite/tests/stranal/sigs/T16859.stderr ===================================== @@ -4,7 +4,7 @@ T16859.bar: <1!A> T16859.baz: <1L><1!P(L)><1C(1,L)> T16859.buz: <1!P(L,L)> T16859.foo: <1L> -T16859.mkInternalName: <1!P(L)><1L><1L> +T16859.mkInternalName: <1!P(L)> T16859.n_loc: <1!P(A,A,A,1L)> T16859.n_occ: <1!P(A,1!P(L,L),A,A)> T16859.n_sort: <1!P(1L,A,A,A)> View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77ef96d9d50fd8512e9bd4324ea5446f1eac1159...964dbea3d708012ecae9077c9e4faa4c88e34a0d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77ef96d9d50fd8512e9bd4324ea5446f1eac1159...964dbea3d708012ecae9077c9e4faa4c88e34a0d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 13:29:32 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Tue, 07 Mar 2023 08:29:32 -0500 Subject: [Git][ghc/ghc][wip/T20749] 2 commits: Simplifier: Eta expand arguments (#23083) Message-ID: <64073c3ca3957_2c78e935f90bc1338a1@gitlab.mail> Sebastian Graf pushed to branch wip/T20749 at Glasgow Haskell Compiler / GHC Commits: d81cad21 by Sebastian Graf at 2023-03-07T14:28:40+01:00 Simplifier: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` Tweaking the Simplifier to eta-expand in args was a bit more painful than expected: * `tryEtaExpandRhs` and `findRhsArity` previously only worked on bindings. But eta expansion of non-recursive bindings is morally the same as eta expansion of arguments. And in fact the binder was never really looked at in the non-recursive case. I was able to make `findRhsArity` cater for both arguments and bindings, as well as have a new function `tryEtaExpandArg` that shares most of its code with that of `tryEtaExpandRhs`. * The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`, which seems to be the main way to simplify args. Hence I consolidated the code path to call `simplArg`, too, renaming to `simplLazyArg`. Fixes #23083. - - - - - beb2ed53 by Sebastian Graf at 2023-03-07T14:29:08+01:00 Make DataCon workers strict in strict fields (#20749) This patch tweaks `exprIsConApp_maybe`, `exprIsHNF` and friends, and Demand Analysis so that they exploit and maintain strictness of DataCon workers. See `Note [Strict fields in Core]` for details. Very little needed to change, and it puts field seq insertion done by Tag Inference into a new perspective: That of *implementing* strict field semantics. Before Tag Inference, DataCon workers are strict. Afterwards they are effectively lazy and field seqs happen around use sites. History has shown that there is no other way to guarantee taggedness and thus the STG Strict Field Invariant. Knock-on changes: * `exprIsHNF` previously used `exprOkForSpeculation` on unlifted arguments instead of recursing into `exprIsHNF`. That regressed the termination analysis in CPR analysis (which simply calls out to `exprIsHNF`), so I made it call `exprOkForSpeculation`, too. * There's a small regression in Demand Analysis, visible in the changed test output of T16859: Previously, a field seq on a variable would give that variable a "used exactly once" demand, now it's "used at least once", because `dmdTransformDataConSig` accounts for future uses of the field that actually all go through the case binder (and hence won't re-enter the potential thunk). The difference should hardly be observable. * The Simplifier's fast path for data constructors only applies to lazy data constructors now. I observed regressions involving Data.Binary.Put's `Pair` data type. * Unfortunately, T21392 does no longer reproduce after this patch, so I marked it as "not broken" in order to track whether we regress again in the future. Fixes #20749, the satisfying conclusion of an annoying saga (cf. the ideas in #21497 and #22475). - - - - - 26 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Stats.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Misc.hs - testsuite/tests/simplCore/should_compile/T18013.stderr - + testsuite/tests/simplCore/should_compile/T23083.hs - + testsuite/tests/simplCore/should_compile/T23083.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/simplStg/should_compile/inferTags002.stderr - testsuite/tests/stranal/sigs/T16859.stderr Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -615,6 +615,8 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri -- See Note [Constructor tag allocation] and #14657 data_con = mkDataCon dc_name declared_infix prom_info (map (const no_bang) arg_tys) + (map (const HsLazy) arg_tys) + (map (const NotMarkedStrict) arg_tys) [] -- No labelled fields tyvars ex_tyvars (mkTyVarBinders SpecifiedSpec user_tyvars) ===================================== compiler/GHC/Core.hs ===================================== @@ -42,7 +42,7 @@ module GHC.Core ( foldBindersOfBindStrict, foldBindersOfBindsStrict, collectBinders, collectTyBinders, collectTyAndValBinders, collectNBinders, collectNValBinders_maybe, - collectArgs, stripNArgs, collectArgsTicks, flattenBinds, + collectArgs, collectValArgs, stripNArgs, collectArgsTicks, flattenBinds, collectFunSimple, exprToType, @@ -994,6 +994,60 @@ tail position: A cast changes the type, but the type must be the same. But operationally, casts are vacuous, so this is a bit unfortunate! See #14610 for ideas how to fix this. +Note [Strict fields in Core] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Evaluating a data constructor worker evaluates its strict fields. + +In other words, if `MkT` is strict in its first field and `xs` reduces to +`error "boom"`, then `MkT xs b` will throw that error. +Conversely, it is sound to seq the field before the call to the constructor, +e.g., with `case xs of xs' { __DEFAULT -> MkT xs' b }`. +Let's call this transformation "field seq insertion". + +Note in particular that the data constructor application `MkT xs b` above is +*not* a value, unless `xs` is! + +This has pervasive effect on the Core pipeline: + + * `exprIsHNF`/`exprIsConLike`/`exprOkForSpeculation` need to assert that the + strict arguments of a DataCon worker are values/ok-for-spec themselves. + + * `exprIsConApp_maybe` inserts field seqs in the `FloatBind`s it returns, so + that the Simplifier, Constant-folding, the pattern-match checker, etc. + all see the insert field seqs when they match on strict workers. Often this + is just to emphasise strict semantics, but for case-of-known constructor + and case-to-let field insertion is *vital*, otherwise these transformations + would lose field seqs. + + * The demand signature of a data constructor is strict in strict field + position, whereas is it's normally lazy. Likewise the demand *transformer* + of a DataCon worker can add stricten up demands on strict field args. + See Note [Demand transformer for data constructors]. + + * In the absence of `-fpedantic-bottoms`, it is still possible that some seqs + are ultimately dropped or delayed due to eta-expansion. + See Note [Dealing with bottom]. + +Strict field semantics is exploited in STG by Note [Tag Inference]: +It performs field seq insertion to statically guarantee *taggedness* of strict +fields, establishing the Note [STG Strict Field Invariant]. (Happily, most +of those seqs are immediately detected as redundant by tag inference and are +omitted.) From then on, DataCon worker semantics are actually lazy, hence it is +important that STG passes maintain the Strict Field Invariant. + + +Historical Note: +The delightfully simple description of strict field semantics is the result of +a long saga (#20749, the bits about strict data constructors in #21497, #22475), +where we tried a more lenient (but actually not) semantics first that would +allow both strict and lazy implementations of DataCon workers. This was favoured +because the "pervasive effect" throughout the compiler was deemed too large +(when it really turned out to be very modest). +Alas, this semantics would require us to implement `exprIsHNF` in *exactly* the +same way as above, otherwise the analysis would not be conservative wrt. the +lenient semantics (which includes the strict one). It is also much harder to +explain and maintain, as it turned out. + ************************************************************************ * * In/Out type synonyms @@ -2080,6 +2134,17 @@ collectArgs expr go (App f a) as = go f (a:as) go e as = (e, as) +-- | Takes a nested application expression and returns the function +-- being applied and the arguments to which it is applied +collectValArgs :: Expr b -> (Expr b, [Arg b]) +collectValArgs expr + = go expr [] + where + go (App f a) as + | isValArg a = go f (a:as) + | otherwise = go f as + go e as = (e, as) + -- | Takes a nested application expression and returns the function -- being applied. Looking through casts and ticks to find it. collectFunSimple :: Expr b -> Expr b ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -48,7 +48,8 @@ module GHC.Core.DataCon ( dataConIsInfix, dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitTyThings, - dataConRepStrictness, dataConImplBangs, dataConBoxer, + dataConRepStrictness, dataConRepStrictness_maybe, + dataConImplBangs, dataConBoxer, splitDataProductType_maybe, @@ -59,7 +60,7 @@ module GHC.Core.DataCon ( isVanillaDataCon, isNewDataCon, isTypeDataCon, classDataCon, dataConCannotMatch, dataConUserTyVarsNeedWrapper, checkDataConTyVars, - isBanged, isMarkedStrict, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked, + isBanged, isUnpacked, isMarkedStrict, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked, specialPromotedDc, -- ** Promotion related functions @@ -95,6 +96,7 @@ import GHC.Types.Unique.FM ( UniqFM ) import GHC.Types.Unique.Set import GHC.Builtin.Uniques( mkAlphaTyVarUnique ) import GHC.Data.Graph.UnVar -- UnVarSet and operations +import GHC.Data.Maybe (orElse) import GHC.Utils.Outputable import GHC.Utils.Misc @@ -502,6 +504,18 @@ data DataCon -- Matches 1-1 with dcOrigArgTys -- Hence length = dataConSourceArity dataCon + dcImplBangs :: [HsImplBang], + -- The actual decisions made (including failures) + -- about the original arguments; 1-1 with orig_arg_tys + -- See Note [Bangs on data constructor arguments] + + dcStricts :: [StrictnessMark], + -- One mark for every field of the DataCon worker; + -- if it's empty, then all fields are lazy, + -- otherwise it has the same length as dataConRepArgTys. + -- See also Note [Strict fields in Core] in GHC.Core + -- for the effect on the strictness signature + dcFields :: [FieldLabel], -- Field labels for this constructor, in the -- same order as the dcOrigArgTys; @@ -777,13 +791,6 @@ data DataConRep -- after unboxing and flattening, -- and *including* all evidence args - , dcr_stricts :: [StrictnessMark] -- 1-1 with dcr_arg_tys - -- See also Note [Data-con worker strictness] - - , dcr_bangs :: [HsImplBang] -- The actual decisions made (including failures) - -- about the original arguments; 1-1 with orig_arg_tys - -- See Note [Bangs on data constructor arguments] - } type DataConEnv a = UniqFM DataCon a -- Keyed by DataCon @@ -852,43 +859,8 @@ eqSpecPreds spec = [ mkPrimEqPred (mkTyVarTy tv) ty instance Outputable EqSpec where ppr (EqSpec tv ty) = ppr (tv, ty) -{- Note [Data-con worker strictness] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Notice that we do *not* say the worker Id is strict even if the data -constructor is declared strict - e.g. data T = MkT ![Int] Bool -Even though most often the evals are done by the *wrapper* $WMkT, there are -situations in which tag inference will re-insert evals around the worker. -So for all intents and purposes the *worker* MkT is strict, too! - -Unfortunately, if we exposed accurate strictness of DataCon workers, we'd -see the following transformation: - - f xs = case xs of xs' { __DEFAULT -> ... case MkT xs b of x { __DEFAULT -> [x] } } -- DmdAnal: Strict in xs - ==> { drop-seq, binder swap on xs' } - f xs = case MkT xs b of x { __DEFAULT -> [x] } -- DmdAnal: Still strict in xs - ==> { case-to-let } - f xs = let x = MkT xs' b in [x] -- DmdAnal: No longer strict in xs! - -I.e., we are ironically losing strictness in `xs` by dropping the eval on `xs` -and then doing case-to-let. The issue is that `exprIsHNF` currently says that -every DataCon worker app is a value. The implicit assumption is that surrounding -evals will have evaluated strict fields like `xs` before! But now that we had -just dropped the eval on `xs`, that assumption is no longer valid. - -Long story short: By keeping the demand signature lazy, the Simplifier will not -drop the eval on `xs` and using `exprIsHNF` to decide case-to-let and others -remains sound. - -Similarly, during demand analysis in dmdTransformDataConSig, we bump up the -field demand with `C_01`, *not* `C_11`, because the latter exposes too much -strictness that will drop the eval on `xs` above. - -This issue is discussed at length in -"Failed idea: no wrappers for strict data constructors" in #21497 and #22475. - -Note [Bangs on data constructor arguments] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Bangs on data constructor arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data T = MkT !Int {-# UNPACK #-} !Int Bool @@ -914,8 +886,8 @@ Terminology: the flag settings in the importing module. Also see Note [Bangs on imported data constructors] in GHC.Types.Id.Make -* The dcr_bangs field of the dcRep field records the [HsImplBang] - If T was defined in this module, Without -O the dcr_bangs might be +* The dcImplBangs field records the [HsImplBang] + If T was defined in this module, Without -O the dcImplBangs might be [HsStrict _, HsStrict _, HsLazy] With -O it might be [HsStrict _, HsUnpack _, HsLazy] @@ -959,6 +931,17 @@ we consult HsImplBang: The boolean flag is used only for this warning. See #11270 for motivation. +* Core passes will often need to know whether the DataCon worker or wrapper in + an application is strict in some (lifted) field or not. This is tracked in the + demand signature attached to a DataCon's worker resp. wrapper Id. + + So if you've got a DataCon dc, you can get the demand signature by + `idDmdSig (dataConWorkId dc)` and make out strict args by testing with + `isStrictDmd`. Similarly, `idDmdSig <$> dataConWrapId_maybe dc` gives + you the demand signature of the wrapper, if it exists. + + These demand signatures are set in GHC.Types.Id.Make. + Note [Data con representation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The dcRepType field contains the type of the representation of a constructor @@ -974,14 +957,14 @@ what it means is the DataCon with all Unpacking having been applied. We can think of this as the Core representation. Here's an example illustrating the Core representation: - data Ord a => T a = MkT Int! a Void# + data Ord a => T a = MkT !Int a Void# Here T :: Ord a => Int -> a -> Void# -> T a but the rep type is Trep :: Int# -> a -> Void# -> T a Actually, the unboxed part isn't implemented yet! -Not that this representation is still *different* from runtime +Note that this representation is still *different* from runtime representation. (Which is what STG uses after unarise). This is how T would end up being used in STG post-unarise: @@ -1106,6 +1089,11 @@ isBanged (HsUnpack {}) = True isBanged (HsStrict {}) = True isBanged HsLazy = False +isUnpacked :: HsImplBang -> Bool +isUnpacked (HsUnpack {}) = True +isUnpacked (HsStrict {}) = False +isUnpacked HsLazy = False + isSrcStrict :: SrcStrictness -> Bool isSrcStrict SrcStrict = True isSrcStrict _ = False @@ -1131,13 +1119,15 @@ cbvFromStrictMark MarkedStrict = MarkedCbv -- | Build a new data constructor mkDataCon :: Name - -> Bool -- ^ Is the constructor declared infix? - -> TyConRepName -- ^ TyConRepName for the promoted TyCon - -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user - -> [FieldLabel] -- ^ Field labels for the constructor, - -- if it is a record, otherwise empty - -> [TyVar] -- ^ Universals. - -> [TyCoVar] -- ^ Existentials. + -> Bool -- ^ Is the constructor declared infix? + -> TyConRepName -- ^ TyConRepName for the promoted TyCon + -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user + -> [HsImplBang] -- ^ Strictness/unpack annotations, as inferred by the compiler + -> [StrictnessMark] -- ^ Strictness marks for the DataCon worker's fields in Core + -> [FieldLabel] -- ^ Field labels for the constructor, + -- if it is a record, otherwise empty + -> [TyVar] -- ^ Universals. + -> [TyCoVar] -- ^ Existentials. -> [InvisTVBinder] -- ^ User-written 'TyVarBinder's. -- These must be Inferred/Specified. -- See @Note [TyVarBinders in DataCons]@ @@ -1156,7 +1146,9 @@ mkDataCon :: Name -- Can get the tag from the TyCon mkDataCon name declared_infix prom_info - arg_stricts -- Must match orig_arg_tys 1-1 + arg_stricts -- Must match orig_arg_tys 1-1 + impl_bangs -- Must match orig_arg_tys 1-1 + str_marks -- Must be empty or match dataConRepArgTys 1-1 fields univ_tvs ex_tvs user_tvbs eq_spec theta @@ -1173,6 +1165,8 @@ mkDataCon name declared_infix prom_info = con where is_vanilla = null ex_tvs && null eq_spec && null theta + str_marks' | not $ any isMarkedStrict str_marks = [] + | otherwise = str_marks con = MkData {dcName = name, dcUnique = nameUnique name, dcVanilla = is_vanilla, dcInfix = declared_infix, @@ -1184,7 +1178,8 @@ mkDataCon name declared_infix prom_info dcStupidTheta = stupid_theta, dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty, dcRepTyCon = rep_tycon, - dcSrcBangs = arg_stricts, + dcSrcBangs = arg_stricts, dcImplBangs = impl_bangs, + dcStricts = str_marks', dcFields = fields, dcTag = tag, dcRepType = rep_ty, dcWorkId = work_id, dcRep = rep, @@ -1412,19 +1407,27 @@ isNullaryRepDataCon :: DataCon -> Bool isNullaryRepDataCon dc = dataConRepArity dc == 0 dataConRepStrictness :: DataCon -> [StrictnessMark] --- ^ Give the demands on the arguments of a --- Core constructor application (Con dc args) -dataConRepStrictness dc = case dcRep dc of - NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc] - DCR { dcr_stricts = strs } -> strs +-- ^ Give the demands on the runtime arguments of a Core DataCon worker +-- application. +-- The length of the list matches `dataConRepArgTys` (e.g., the number +-- of runtime arguments). +dataConRepStrictness dc + = dataConRepStrictness_maybe dc + `orElse` map (const NotMarkedStrict) (dataConRepArgTys dc) + +dataConRepStrictness_maybe :: DataCon -> Maybe [StrictnessMark] +-- ^ Give the demands on the runtime arguments of a Core DataCon worker +-- application or `Nothing` if all of them are lazy. +-- The length of the list matches `dataConRepArgTys` (e.g., the number +-- of runtime arguments). +dataConRepStrictness_maybe dc + | null (dcStricts dc) = Nothing + | otherwise = Just (dcStricts dc) dataConImplBangs :: DataCon -> [HsImplBang] -- The implementation decisions about the strictness/unpack of each -- source program argument to the data constructor -dataConImplBangs dc - = case dcRep dc of - NoDataConRep -> replicate (dcSourceArity dc) HsLazy - DCR { dcr_bangs = bangs } -> bangs +dataConImplBangs dc = dcImplBangs dc dataConBoxer :: DataCon -> Maybe DataConBoxer dataConBoxer (MkData { dcRep = DCR { dcr_boxer = boxer } }) = Just boxer ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -872,9 +872,16 @@ exprEtaExpandArity opts e * * ********************************************************************* -} -findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr - -> (Bool, SafeArityType) --- This implements the fixpoint loop for arity analysis +findRhsArity + :: ArityOpts + -> Maybe Id -- ^ `Just bndr` when it's a recursive RHS bound by bndr + -> Bool -- ^ Is it a join binding? + -> [OneShotInfo] -- ^ The one-shot info from the use sites, perhaps from + -- `idDemandOneShots` of the binder + -> CoreExpr -- ^ The RHS (or argument expression) + -> Type -- ^ Type of the CoreExpr + -> (Bool, SafeArityType) +-- ^ This implements the fixpoint loop for arity analysis -- See Note [Arity analysis] -- -- The Bool is True if the returned arity is greater than (exprArity rhs) @@ -884,8 +891,8 @@ findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr -- Returns an SafeArityType that is guaranteed trimmed to typeArity of 'bndr' -- See Note [Arity trimming] -findRhsArity opts is_rec bndr rhs - | isJoinId bndr +findRhsArity opts mb_rec_bndr is_join use_one_shots rhs rhs_ty + | is_join = (False, join_arity_type) -- False: see Note [Do not eta-expand join points] -- But do return the correct arity and bottom-ness, because @@ -900,28 +907,27 @@ findRhsArity opts is_rec bndr rhs old_arity = exprArity rhs init_env :: ArityEnv - init_env = findRhsArityEnv opts (isJoinId bndr) + init_env = findRhsArityEnv opts is_join -- Non-join-points only - non_join_arity_type = case is_rec of - Recursive -> go 0 botArityType - NonRecursive -> step init_env + non_join_arity_type = case mb_rec_bndr of + Just bndr -> go 0 bndr botArityType + Nothing -> step init_env arity_increased = arityTypeArity non_join_arity_type > old_arity -- Join-points only -- See Note [Arity for non-recursive join bindings] -- and Note [Arity for recursive join bindings] - join_arity_type = case is_rec of - Recursive -> go 0 botArityType - NonRecursive -> trimArityType ty_arity (cheapArityType rhs) + join_arity_type = case mb_rec_bndr of + Just bndr -> go 0 bndr botArityType + Nothing -> trimArityType ty_arity (cheapArityType rhs) - ty_arity = typeArity (idType bndr) - id_one_shots = idDemandOneShots bndr + ty_arity = typeArity rhs_ty step :: ArityEnv -> SafeArityType step env = trimArityType ty_arity $ safeArityType $ -- See Note [Arity invariants for bindings], item (3) - arityType env rhs `combineWithDemandOneShots` id_one_shots + arityType env rhs `combineWithDemandOneShots` use_one_shots -- trimArityType: see Note [Trim arity inside the loop] -- combineWithDemandOneShots: take account of the demand on the -- binder. Perhaps it is always called with 2 args @@ -934,8 +940,8 @@ findRhsArity opts is_rec bndr rhs -- is assumed to be sound. In other words, arities should never -- decrease. Result: the common case is that there is just one -- iteration - go :: Int -> SafeArityType -> SafeArityType - go !n cur_at@(AT lams div) + go :: Int -> Id -> SafeArityType -> SafeArityType + go !n bndr cur_at@(AT lams div) | not (isDeadEndDiv div) -- the "stop right away" case , length lams <= old_arity = cur_at -- from above | next_at == cur_at = cur_at @@ -944,7 +950,7 @@ findRhsArity opts is_rec bndr rhs = warnPprTrace (debugIsOn && n > 2) "Exciting arity" (nest 2 (ppr bndr <+> ppr cur_at <+> ppr next_at $$ ppr rhs)) $ - go (n+1) next_at + go (n+1) bndr next_at where next_at = step (extendSigEnv init_env bndr cur_at) @@ -964,30 +970,6 @@ combineWithDemandOneShots at@(AT lams div) oss zip_lams ((ch,os1):lams) (os2:oss) = (ch, os1 `bestOneShot` os2) : zip_lams lams oss -idDemandOneShots :: Id -> [OneShotInfo] -idDemandOneShots bndr - = call_arity_one_shots `zip_lams` dmd_one_shots - where - call_arity_one_shots :: [OneShotInfo] - call_arity_one_shots - | call_arity == 0 = [] - | otherwise = NoOneShotInfo : replicate (call_arity-1) OneShotLam - -- Call Arity analysis says the function is always called - -- applied to this many arguments. The first NoOneShotInfo is because - -- if Call Arity says "always applied to 3 args" then the one-shot info - -- we get is [NoOneShotInfo, OneShotLam, OneShotLam] - call_arity = idCallArity bndr - - dmd_one_shots :: [OneShotInfo] - -- If the demand info is C(x,C(1,C(1,.))) then we know that an - -- application to one arg is also an application to three - dmd_one_shots = argOneShots (idDemandInfo bndr) - - -- Take the *longer* list - zip_lams (lam1:lams1) (lam2:lams2) = (lam1 `bestOneShot` lam2) : zip_lams lams1 lams2 - zip_lams [] lams2 = lams2 - zip_lams lams1 [] = lams1 - {- Note [Arity analysis] ~~~~~~~~~~~~~~~~~~~~~~~~ The motivating example for arity analysis is this: @@ -1461,7 +1443,7 @@ myExprIsCheap (AE { am_opts = opts, am_sigs = sigs }) e mb_ty -- See Note [Eta expanding through dictionaries] -- See Note [Eta expanding through CallStacks] - cheap_fun e = exprIsCheapX (myIsCheapApp sigs) e + cheap_fun e = exprIsCheapX (myIsCheapApp sigs) False e -- | A version of 'isCheapApp' that considers results from arity analysis. -- See Note [Arity analysis] for what's in the signature environment and why ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -46,7 +46,7 @@ import GHC.Core import GHC.Core.Make import GHC.Core.SimpleOpt ( exprIsConApp_maybe, exprIsLiteral_maybe ) import GHC.Core.DataCon ( DataCon,dataConTagZ, dataConTyCon, dataConWrapId, dataConWorkId ) -import GHC.Core.Utils ( cheapEqExpr, exprIsHNF +import GHC.Core.Utils ( cheapEqExpr, exprOkForSpeculation , stripTicksTop, stripTicksTopT, mkTicks ) import GHC.Core.Multiplicity import GHC.Core.Rules.Config @@ -1936,7 +1936,7 @@ Things to note Implementing seq#. The compiler has magic for SeqOp in -- GHC.Core.Opt.ConstantFold.seqRule: eliminate (seq# s) +- GHC.Core.Opt.ConstantFold.seqRule: eliminate (seq# s) - GHC.StgToCmm.Expr.cgExpr, and cgCase: special case for seq# @@ -1951,7 +1951,7 @@ Implementing seq#. The compiler has magic for SeqOp in seqRule :: RuleM CoreExpr seqRule = do [Type _ty_a, Type _ty_s, a, s] <- getArgs - guard $ exprIsHNF a + guard $ exprOkForSpeculation a return $ mkCoreUnboxedTuple [s, a] -- spark# :: forall a s . a -> State# s -> (# State# s, a #) ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -297,9 +297,16 @@ data TermFlag -- Better than using a Bool -- See Note [Nested CPR] exprTerminates :: CoreExpr -> TermFlag +-- ^ A /very/ simple termination analysis. exprTerminates e - | exprIsHNF e = Terminates -- A /very/ simple termination analysis. - | otherwise = MightDiverge + | exprIsHNF e = Terminates + | exprOkForSpeculation e = Terminates + | otherwise = MightDiverge + -- Annyingly, we have to check both for HNF and ok-for-spec. + -- * `I# (x# *# 2#)` is ok-for-spec, but not in HNF. Still worth CPR'ing! + -- * `lvl` is an HNF if its unfolding is evaluated + -- (perhaps `lvl = I# 0#` at top-level). But, tiresomely, it is never + -- ok-for-spec due to Note [exprOkForSpeculation and evaluated variables]. cprAnalApp :: AnalEnv -> CoreExpr -> [(CprType, CoreArg)] -> (CprType, CoreExpr) -- Main function that takes care of /nested/ CPR. See Note [Nested CPR] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -814,6 +814,10 @@ to the Divergence lattice, but in practice it turned out to be hard to untaint from 'topDiv' to 'conDiv', leading to bugs, performance regressions and complexity that didn't justify the single fixed testcase T13380c. +You might think that we should check for side-effects rather than just for +precise exceptions. Right you are! See Note [Side-effects and strictness] +for why we unfortunately do not. + Note [Demand analysis for recursive data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ T11545 features a single-product, recursive data type ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -8,14 +8,13 @@ module GHC.Core.Opt.Simplify.Env ( -- * The simplifier mode - SimplMode(..), updMode, - smPedanticBottoms, smPlatform, + SimplMode(..), updMode, smPlatform, -- * Environments SimplEnv(..), pprSimplEnv, -- Temp not abstract seArityOpts, seCaseCase, seCaseFolding, seCaseMerge, seCastSwizzle, seDoEtaReduction, seEtaExpand, seFloatEnable, seInline, seNames, - seOptCoercionOpts, sePedanticBottoms, sePhase, sePlatform, sePreInline, + seOptCoercionOpts, sePhase, sePlatform, sePreInline, seRuleOpts, seRules, seUnfoldingOpts, mkSimplEnv, extendIdSubst, extendTvSubst, extendCvSubst, @@ -216,9 +215,6 @@ seNames env = sm_names (seMode env) seOptCoercionOpts :: SimplEnv -> OptCoercionOpts seOptCoercionOpts env = sm_co_opt_opts (seMode env) -sePedanticBottoms :: SimplEnv -> Bool -sePedanticBottoms env = smPedanticBottoms (seMode env) - sePhase :: SimplEnv -> CompilerPhase sePhase env = sm_phase (seMode env) @@ -273,9 +269,6 @@ instance Outputable SimplMode where where pp_flag f s = ppUnless f (text "no") <+> s -smPedanticBottoms :: SimplMode -> Bool -smPedanticBottoms opts = ao_ped_bot (sm_arity_opts opts) - smPlatform :: SimplMode -> Platform smPlatform opts = roPlatform (sm_rule_opts opts) ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -32,7 +32,7 @@ import GHC.Core.Reduction import GHC.Core.Coercion.Opt ( optCoercion ) import GHC.Core.FamInstEnv ( FamInstEnv, topNormaliseType_maybe ) import GHC.Core.DataCon - ( DataCon, dataConWorkId, dataConRepStrictness + ( DataCon, dataConWorkId, dataConRepStrictness, dataConRepStrictness_maybe , dataConRepArgTys, isUnboxedTupleDataCon , StrictnessMark (..) ) import GHC.Core.Opt.Stats ( Tick(..) ) @@ -1517,7 +1517,7 @@ rebuild env expr cont ApplyToVal { sc_arg = arg, sc_env = se, sc_dup = dup_flag , sc_cont = cont, sc_hole_ty = fun_ty } -- See Note [Avoid redundant simplification] - -> do { (_, _, arg') <- simplArg env dup_flag fun_ty se arg + -> do { (_, _, arg') <- simplLazyArg env dup_flag fun_ty Nothing topDmd se arg ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv @@ -1633,7 +1633,6 @@ simplCast env body co0 cont0 , sc_hole_ty = coercionLKind co }) } -- NB! As the cast goes past, the -- type of the hole changes (#16312) - -- (f |> co) e ===> (f (e |> co1)) |> co2 -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 @@ -1652,7 +1651,7 @@ simplCast env body co0 cont0 -- See Note [Avoiding exponential behaviour] MCo co1 -> - do { (dup', arg_se', arg') <- simplArg env dup fun_ty arg_se arg + do { (dup', arg_se', arg') <- simplLazyArg env dup fun_ty Nothing topDmd arg_se arg -- When we build the ApplyTo we can't mix the OutCoercion -- 'co' with the InExpr 'arg', so we simplify -- to make it all consistent. It's a bit messy. @@ -1678,17 +1677,21 @@ simplCast env body co0 cont0 -- See Note [Representation polymorphism invariants] in GHC.Core -- test: typecheck/should_run/EtaExpandLevPoly -simplArg :: SimplEnv -> DupFlag - -> OutType -- Type of the function applied to this arg - -> StaticEnv -> CoreExpr -- Expression with its static envt - -> SimplM (DupFlag, StaticEnv, OutExpr) -simplArg env dup_flag fun_ty arg_env arg +simplLazyArg :: SimplEnv -> DupFlag + -> OutType -- Type of the function applied to this arg + -> Maybe ArgInfo + -> Demand -- Demand on the argument expr + -> StaticEnv -> CoreExpr -- Expression with its static envt + -> SimplM (DupFlag, StaticEnv, OutExpr) +simplLazyArg env dup_flag fun_ty mb_arg_info arg_dmd arg_env arg | isSimplified dup_flag = return (dup_flag, arg_env, arg) | otherwise = do { let arg_env' = arg_env `setInScopeFromE` env - ; arg' <- simplExprC arg_env' arg (mkBoringStop (funArgTy fun_ty)) - ; return (Simplified, zapSubstEnv arg_env', arg') } + ; let arg_ty = funArgTy fun_ty + ; arg1 <- simplExprC arg_env' arg (mkLazyArgStop arg_ty mb_arg_info) + ; (_arity_type, arg2) <- tryEtaExpandArg env arg_dmd arg1 arg_ty + ; return (Simplified, zapSubstEnv arg_env', arg2) } -- Return a StaticEnv that includes the in-scope set from 'env', -- because arg' may well mention those variables (#20639) @@ -2091,14 +2094,14 @@ zap the SubstEnv. This is VITAL. Consider We'll clone the inner \x, adding x->x' in the id_subst Then when we inline y, we must *not* replace x by x' in the inlined copy!! -Note [Fast path for data constructors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Fast path for lazy data constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For applications of a data constructor worker, the full glory of rebuildCall is a waste of effort; * They never inline, obviously * They have no rewrite rules -* They are not strict (see Note [Data-con worker strictness] - in GHC.Core.DataCon) +* Though they might be strict (see Note [Strict fields in Core] in GHC.Core), + we will exploit that strictness through their demand signature So it's fine to zoom straight to `rebuild` which just rebuilds the call in a very straightforward way. @@ -2122,7 +2125,8 @@ simplVar env var simplIdF :: SimplEnv -> InId -> SimplCont -> SimplM (SimplFloats, OutExpr) simplIdF env var cont - | isDataConWorkId var -- See Note [Fast path for data constructors] + | Just dc <- isDataConWorkId_maybe var -- See Note [Fast path for lazy data constructors] + , Nothing <- dataConRepStrictness_maybe dc = rebuild env (Var var) cont | otherwise = case substId env var of @@ -2281,12 +2285,9 @@ rebuildCall env fun_info -- There is no benefit (unlike in a let-binding), and we'd -- have to be very careful about bogus strictness through -- floating a demanded let. - = do { arg' <- simplExprC (arg_se `setInScopeFromE` env) arg - (mkLazyArgStop arg_ty fun_info) + = do { let (dmd:_) = ai_dmds fun_info + ; (_, _, arg') <- simplLazyArg env dup_flag fun_ty (Just fun_info) dmd arg_se arg ; rebuildCall env (addValArgTo fun_info arg' fun_ty) cont } - where - arg_ty = funArgTy fun_ty - ---------- No further useful info, revert to generic rebuild ------------ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont @@ -3304,7 +3305,7 @@ a case pattern. This is *important*. Consider We really must record that b is already evaluated so that we don't go and re-evaluate it when constructing the result. -See Note [Data-con worker strictness] in GHC.Core.DataCon +See Note [Strict fields in Core] in GHC.Core. NB: simplLamBndrs preserves this eval info @@ -3723,7 +3724,7 @@ mkDupableContWithDmds env dmds do { let (dmd:cont_dmds) = dmds -- Never fails ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 - ; (_, se', arg') <- simplArg env' dup hole_ty se arg + ; (_, se', arg') <- simplLazyArg env' dup hole_ty Nothing dmd se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ; let all_floats = floats1 `addLetFloats` let_floats2 ; return ( all_floats ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -9,7 +9,7 @@ The simplifier utilities module GHC.Core.Opt.Simplify.Utils ( -- Rebuilding rebuildLam, mkCase, prepareAlts, - tryEtaExpandRhs, wantEtaExpansion, + tryEtaExpandRhs, tryEtaExpandArg, wantEtaExpansion, -- Inlining, preInlineUnconditionally, postInlineUnconditionally, @@ -461,8 +461,9 @@ mkRhsStop :: OutType -> RecFlag -> Demand -> SimplCont -- See Note [RHS of lets] in GHC.Core.Unfold mkRhsStop ty is_rec bndr_dmd = Stop ty (RhsCtxt is_rec) (subDemandIfEvaluated bndr_dmd) -mkLazyArgStop :: OutType -> ArgInfo -> SimplCont -mkLazyArgStop ty fun_info = Stop ty (lazyArgContext fun_info) arg_sd +mkLazyArgStop :: OutType -> Maybe ArgInfo -> SimplCont +mkLazyArgStop ty Nothing = mkBoringStop ty +mkLazyArgStop ty (Just fun_info) = Stop ty (lazyArgContext fun_info) arg_sd where arg_sd = subDemandIfEvaluated (Partial.head (ai_dmds fun_info)) @@ -1738,7 +1739,7 @@ rebuildLam env bndrs@(bndr:_) body cont , seEtaExpand env , any isRuntimeVar bndrs -- Only when there is at least one value lambda already , Just body_arity <- exprEtaExpandArity (seArityOpts env) body - = do { tick (EtaExpansion bndr) + = do { tick (EtaExpansion Nothing) ; let body' = etaExpandAT in_scope body_arity body ; traceSmpl "eta expand" (vcat [text "before" <+> ppr body , text "after" <+> ppr body']) @@ -1859,15 +1860,39 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpandRhs env bind_cxt bndr rhs + = tryEtaExpandArgOrRhs env mb_rec_bndr (isJoinBC bind_cxt) + (idDemandOneShots bndr) rhs (idType bndr) + where + mb_rec_bndr = case bindContextRec bind_cxt of + Recursive -> Just bndr + NonRecursive -> Nothing + +tryEtaExpandArg :: SimplEnv -> Demand -> OutExpr -> OutType + -> SimplM (ArityType, OutExpr) +-- See Note [Eta-expanding at let bindings] +tryEtaExpandArg env arg_dmd arg arg_ty + = tryEtaExpandArgOrRhs env Nothing False (argOneShots arg_dmd) arg arg_ty + +tryEtaExpandArgOrRhs + :: SimplEnv + -> Maybe OutId -- ^ `Just bndr` when it's a recursive RHS bound by bndr + -> Bool -- ^ Is it a join binding? + -> [OneShotInfo] -- ^ The one-shot info from the use sites, perhaps from + -- `idDemandOneShots` of the binder + -> OutExpr -- ^ The RHS (or argument expression) + -> OutType -- ^ Type of the CoreExpr + -> SimplM (ArityType, OutExpr) +-- See Note [Eta-expanding at let bindings] +tryEtaExpandArgOrRhs env mb_rec_bndr is_join use_one_shots rhs rhs_ty | do_eta_expand -- If the current manifest arity isn't enough -- (never true for join points) , seEtaExpand env -- and eta-expansion is on , wantEtaExpansion rhs = -- Do eta-expansion. - assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ + assertPpr( not is_join ) (ppr mb_rec_bndr) $ -- assert: this never happens for join points; see GHC.Core.Opt.Arity -- Note [Do not eta-expand join points] - do { tick (EtaExpansion bndr) + do { tick (EtaExpansion mb_rec_bndr) ; return (arity_type, etaExpandAT in_scope arity_type rhs) } | otherwise @@ -1876,8 +1901,7 @@ tryEtaExpandRhs env bind_cxt bndr rhs where in_scope = getInScope env arity_opts = seArityOpts env - is_rec = bindContextRec bind_cxt - (do_eta_expand, arity_type) = findRhsArity arity_opts is_rec bndr rhs + (do_eta_expand, arity_type) = findRhsArity arity_opts mb_rec_bndr is_join use_one_shots rhs rhs_ty wantEtaExpansion :: CoreExpr -> Bool -- Mostly True; but False of PAPs which will immediately eta-reduce again @@ -1890,6 +1914,30 @@ wantEtaExpansion (Var {}) = False wantEtaExpansion (Lit {}) = False wantEtaExpansion _ = True +idDemandOneShots :: Id -> [OneShotInfo] +idDemandOneShots bndr + = call_arity_one_shots `zip_lams` dmd_one_shots + where + call_arity_one_shots :: [OneShotInfo] + call_arity_one_shots + | call_arity == 0 = [] + | otherwise = NoOneShotInfo : replicate (call_arity-1) OneShotLam + -- Call Arity analysis says the function is always called + -- applied to this many arguments. The first NoOneShotInfo is because + -- if Call Arity says "always applied to 3 args" then the one-shot info + -- we get is [NoOneShotInfo, OneShotLam, OneShotLam] + call_arity = idCallArity bndr + + dmd_one_shots :: [OneShotInfo] + -- If the demand info is C(x,C(1,C(1,.))) then we know that an + -- application to one arg is also an application to three + dmd_one_shots = argOneShots (idDemandInfo bndr) + + -- Take the *longer* list + zip_lams (lam1:lams1) (lam2:lams2) = (lam1 `bestOneShot` lam2) : zip_lams lams1 lams2 + zip_lams [] lams2 = lams2 + zip_lams lams1 [] = lams1 + {- Note [Eta-expanding at let bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Stats.hs ===================================== @@ -226,7 +226,7 @@ data Tick -- See Note [Which transformations are innocuous] | RuleFired FastString -- Rule name | LetFloatFromLet - | EtaExpansion Id -- LHS binder + | EtaExpansion (Maybe Id) -- LHS binder, if recursive | EtaReduction Id -- Binder on outer lambda | BetaReduction Id -- Lambda binder ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -1219,11 +1219,8 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr -- simplifier produces rhs[exp/a], changing semantics if exp is not ok-for-spec -- Good: returning (Mk#, [x]) with a float of case exp of x { DEFAULT -> [] } -- simplifier produces case exp of a { DEFAULT -> exp[x/a] } - = let arg' = subst_expr subst arg - bndr = uniqAway (subst_in_scope subst) (mkWildValBinder ManyTy arg_type) - float = FloatCase arg' bndr DEFAULT [] - subst' = subst_extend_in_scope subst bndr - in go subst' (float:floats) fun (CC (Var bndr : args) co) + , (subst', float, bndr) <- case_bind subst arg arg_type + = go subst' (float:floats) fun (CC (Var bndr : args) co) | otherwise = go subst floats fun (CC (subst_expr subst arg : args) co) @@ -1262,8 +1259,9 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr | Just con <- isDataConWorkId_maybe fun , count isValArg args == idArity fun - = succeedWith in_scope floats $ - pushCoDataCon con args co + , (in_scope', seq_floats, args') <- mkFieldSeqFloats in_scope con args + = succeedWith in_scope' (seq_floats ++ floats) $ + pushCoDataCon con args' co -- Look through data constructor wrappers: they inline late (See Note -- [Activation for data constructor wrappers]) but we want to do @@ -1349,6 +1347,36 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr extend (Left in_scope) v e = Right (extendSubst (mkEmptySubst in_scope) v e) extend (Right s) v e = Right (extendSubst s v e) + case_bind :: Either InScopeSet Subst -> CoreExpr -> Type -> (Either InScopeSet Subst, FloatBind, Id) + case_bind subst expr expr_ty = (subst', float, bndr) + where + bndr = setCaseBndrEvald MarkedStrict $ + uniqAway (subst_in_scope subst) $ + mkWildValBinder ManyTy expr_ty + subst' = subst_extend_in_scope subst bndr + expr' = subst_expr subst expr + float = FloatCase expr' bndr DEFAULT [] + + mkFieldSeqFloats :: InScopeSet -> DataCon -> [CoreExpr] -> (InScopeSet, [FloatBind], [CoreExpr]) + mkFieldSeqFloats in_scope dc args + | Nothing <- dataConRepStrictness_maybe dc + = (in_scope, [], args) + | otherwise + = (in_scope', floats', ty_args ++ val_args') + where + (ty_args, val_args) = splitAtList (dataConUnivAndExTyCoVars dc) args + (in_scope', floats', val_args') = foldr do_one (in_scope, [], []) $ zipEqual "mkFieldSeqFloats" str_marks val_args + str_marks = dataConRepStrictness dc + do_one (str, arg) (in_scope,floats,args) + | NotMarkedStrict <- str = (in_scope, floats, arg:args) + | Var v <- arg, is_evald v = (in_scope, floats, arg:args) + | otherwise = (in_scope', float:floats, Var bndr:args) + where + is_evald v = isId v && isEvaldUnfolding (idUnfolding v) + (in_scope', float, bndr) = + case case_bind (Left in_scope) arg (exprType arg) of + (Left in_scope', float, bndr) -> (in_scope', float, bndr) + (right, _, _) -> pprPanic "case_bind did not preserve Left" (ppr in_scope $$ ppr arg $$ ppr right) -- See Note [exprIsConApp_maybe on literal strings] dealWithStringLiteral :: Var -> BS.ByteString -> Coercion ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1252,18 +1252,23 @@ in this (which it previously was): in \w. v True -} --------------------- -exprIsWorkFree :: CoreExpr -> Bool -- See Note [exprIsWorkFree] -exprIsWorkFree e = exprIsCheapX isWorkFreeApp e - -exprIsCheap :: CoreExpr -> Bool -exprIsCheap e = exprIsCheapX isCheapApp e +------------------------------------- +type CheapAppFun = Id -> Arity -> Bool + -- Is an application of this function to n *value* args + -- always cheap, assuming the arguments are cheap? + -- True mainly of data constructors, partial applications; + -- but with minor variations: + -- isWorkFreeApp + -- isCheapApp + -- isExpandableApp -exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool +exprIsCheapX :: CheapAppFun -> Bool -> CoreExpr -> Bool {-# INLINE exprIsCheapX #-} --- allow specialization of exprIsCheap and exprIsWorkFree +-- allow specialization of exprIsCheap, exprIsWorkFree and exprIsExpandable -- instead of having an unknown call to ok_app -exprIsCheapX ok_app e +-- expandable: Only True for exprIsExpandable, where Case and Let are never +-- expandable. +exprIsCheapX ok_app expandable e = ok e where ok e = go 0 e @@ -1274,98 +1279,34 @@ exprIsCheapX ok_app e go _ (Type {}) = True go _ (Coercion {}) = True go n (Cast e _) = go n e - go n (Case scrut _ _ alts) = ok scrut && - and [ go n rhs | Alt _ _ rhs <- alts ] go n (Tick t e) | tickishCounts t = False | otherwise = go n e go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e | otherwise = go n e go n (App f e) | isRuntimeArg e = go (n+1) f && ok e | otherwise = go n f - go n (Let (NonRec _ r) e) = go n e && ok r - go n (Let (Rec prs) e) = go n e && all (ok . snd) prs + go n (Case scrut _ _ alts) = not expandable && ok scrut && + and [ go n rhs | Alt _ _ rhs <- alts ] + go n (Let (NonRec _ r) e) = not expandable && go n e && ok r + go n (Let (Rec prs) e) = not expandable && go n e && all (ok . snd) prs -- Case: see Note [Case expressions are work-free] -- App, Let: see Note [Arguments and let-bindings exprIsCheapX] +-------------------- +exprIsWorkFree :: CoreExpr -> Bool +-- See Note [exprIsWorkFree] +exprIsWorkFree e = exprIsCheapX isWorkFreeApp False e -{- Note [exprIsExpandable] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -An expression is "expandable" if we are willing to duplicate it, if doing -so might make a RULE or case-of-constructor fire. Consider - let x = (a,b) - y = build g - in ....(case x of (p,q) -> rhs)....(foldr k z y).... - -We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold), -but we do want - - * the case-expression to simplify - (via exprIsConApp_maybe, exprIsLiteral_maybe) - - * the foldr/build RULE to fire - (by expanding the unfolding during rule matching) - -So we classify the unfolding of a let-binding as "expandable" (via the -uf_expandable field) if we want to do this kind of on-the-fly -expansion. Specifically: - -* True of constructor applications (K a b) - -* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic. - (NB: exprIsCheap might not be true of this) - -* False of case-expressions. If we have - let x = case ... in ...(case x of ...)... - we won't simplify. We have to inline x. See #14688. - -* False of let-expressions (same reason); and in any case we - float lets out of an RHS if doing so will reveal an expandable - application (see SimplEnv.doFloatFromRhs). - -* Take care: exprIsExpandable should /not/ be true of primops. I - found this in test T5623a: - let q = /\a. Ptr a (a +# b) - in case q @ Float of Ptr v -> ...q... - - q's inlining should not be expandable, else exprIsConApp_maybe will - say that (q @ Float) expands to (Ptr a (a +# b)), and that will - duplicate the (a +# b) primop, which we should not do lightly. - (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) --} +-------------------- +exprIsCheap :: CoreExpr -> Bool +-- See Note [exprIsCheap] +exprIsCheap e = exprIsCheapX isCheapApp False e -------------------------------------- +-------------------- exprIsExpandable :: CoreExpr -> Bool -- See Note [exprIsExpandable] -exprIsExpandable e - = ok e - where - ok e = go 0 e - - -- n is the number of value arguments - go n (Var v) = isExpandableApp v n - go _ (Lit {}) = True - go _ (Type {}) = True - go _ (Coercion {}) = True - go n (Cast e _) = go n e - go n (Tick t e) | tickishCounts t = False - | otherwise = go n e - go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e - | otherwise = go n e - go n (App f e) | isRuntimeArg e = go (n+1) f && ok e - | otherwise = go n f - go _ (Case {}) = False - go _ (Let {}) = False - - -------------------------------------- -type CheapAppFun = Id -> Arity -> Bool - -- Is an application of this function to n *value* args - -- always cheap, assuming the arguments are cheap? - -- True mainly of data constructors, partial applications; - -- but with minor variations: - -- isWorkFreeApp - -- isCheapApp +exprIsExpandable e = exprIsCheapX isExpandableApp True e isWorkFreeApp :: CheapAppFun isWorkFreeApp fn n_val_args @@ -1384,7 +1325,7 @@ isCheapApp fn n_val_args | isDeadEndId fn = True -- See Note [isCheapApp: bottoming functions] | otherwise = case idDetails fn of - DataConWorkId {} -> True -- Actually handled by isWorkFreeApp + -- DataConWorkId {} -> _ -- Handled by isWorkFreeApp RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId op _ -> primOpIsCheap op @@ -1399,6 +1340,7 @@ isExpandableApp fn n_val_args | isWorkFreeApp fn n_val_args = True | otherwise = case idDetails fn of + -- DataConWorkId {} -> _ -- Handled by isWorkFreeApp RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId {} -> False @@ -1430,6 +1372,50 @@ isExpandableApp fn n_val_args I'm not sure why we have a special case for bottoming functions in isCheapApp. Maybe we don't need it. +Note [exprIsExpandable] +~~~~~~~~~~~~~~~~~~~~~~~ +An expression is "expandable" if we are willing to duplicate it, if doing +so might make a RULE or case-of-constructor fire. Consider + let x = (a,b) + y = build g + in ....(case x of (p,q) -> rhs)....(foldr k z y).... + +We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold), +but we do want + + * the case-expression to simplify + (via exprIsConApp_maybe, exprIsLiteral_maybe) + + * the foldr/build RULE to fire + (by expanding the unfolding during rule matching) + +So we classify the unfolding of a let-binding as "expandable" (via the +uf_expandable field) if we want to do this kind of on-the-fly +expansion. Specifically: + +* True of constructor applications (K a b) + +* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic. + (NB: exprIsCheap might not be true of this) + +* False of case-expressions. If we have + let x = case ... in ...(case x of ...)... + we won't simplify. We have to inline x. See #14688. + +* False of let-expressions (same reason); and in any case we + float lets out of an RHS if doing so will reveal an expandable + application (see SimplEnv.doFloatFromRhs). + +* Take care: exprIsExpandable should /not/ be true of primops. I + found this in test T5623a: + let q = /\a. Ptr a (a +# b) + in case q @ Float of Ptr v -> ...q... + + q's inlining should not be expandable, else exprIsConApp_maybe will + say that (q @ Float) expands to (Ptr a (a +# b)), and that will + duplicate the (a +# b) primop, which we should not do lightly. + (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) + Note [isExpandableApp: bottoming functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important that isExpandableApp does not respond True to bottoming @@ -1573,10 +1559,10 @@ expr_ok fun_ok primop_ok (Case scrut bndr _ alts) && altsAreExhaustive alts expr_ok fun_ok primop_ok other_expr - | (expr, args) <- collectArgs other_expr + | (expr, val_args) <- collectValArgs other_expr = case stripTicksTopE (not . tickishCounts) expr of Var f -> - app_ok fun_ok primop_ok f args + app_ok fun_ok primop_ok f val_args -- 'LitRubbish' is the only literal that can occur in the head of an -- application and will not be matched by the above case (Var /= Lit). @@ -1590,8 +1576,8 @@ expr_ok fun_ok primop_ok other_expr _ -> False ----------------------------- -app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool -app_ok fun_ok primop_ok fun args +app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreArg] -> Bool +app_ok fun_ok primop_ok fun val_args | not (fun_ok fun) = False -- This code path is only taken for Note [Speculative evaluation] | otherwise @@ -1600,21 +1586,22 @@ app_ok fun_ok primop_ok fun args -- DFuns terminate, unless the dict is implemented -- with a newtype in which case they may not - DataConWorkId {} -> True - -- The strictness of the constructor has already - -- been expressed by its "wrapper", so we don't need - -- to take the arguments into account + DataConWorkId dc + | Just str_marks <- dataConRepStrictness_maybe dc + -> all3Prefix field_ok str_marks val_arg_tys val_args + | otherwise + -> all2Prefix arg_ok val_arg_tys val_args ClassOpId _ is_terminating_result | is_terminating_result -- See Note [exprOkForSpeculation and type classes] - -> assertPpr (n_val_args == 1) (ppr fun $$ ppr args) $ + -> assertPpr (n_val_args == 1) (ppr fun $$ ppr val_args) $ True -- assert: terminating result type => can't be applied; -- c.f the _other case below PrimOpId op _ | primOpIsDiv op - , [arg1, Lit lit] <- args + , [arg1, Lit lit] <- val_args -> not (isZeroLit lit) && expr_ok fun_ok primop_ok arg1 -- Special case for dividing operations that fail -- In general they are NOT ok-for-speculation @@ -1632,13 +1619,13 @@ app_ok fun_ok primop_ok fun args | otherwise -> primop_ok op -- Check the primop itself - && and (zipWith arg_ok arg_tys args) -- Check the arguments + && all2Prefix arg_ok val_arg_tys val_args -- Check the arguments _other -- Unlifted and terminating types; -- Also c.f. the Var case of exprIsHNF | isTerminatingType fun_ty -- See Note [exprOkForSpeculation and type classes] || definitelyUnliftedType fun_ty - -> assertPpr (n_val_args == 0) (ppr fun $$ ppr args) + -> assertPpr (n_val_args == 0) (ppr fun $$ ppr val_args) True -- Both terminating types (e.g. Eq a), and unlifted types (e.g. Int#) -- are non-functions and so will have no value args. The assert is -- just to check this. @@ -1647,7 +1634,7 @@ app_ok fun_ok primop_ok fun args -- Partial applications | idArity fun > n_val_args -> - and (zipWith arg_ok arg_tys args) -- Check the arguments + all2Prefix arg_ok val_arg_tys val_args -- Check the arguments -- Functions that terminate fast without raising exceptions etc -- See Note [Discarding unnecessary unsafeEqualityProofs] @@ -1659,18 +1646,27 @@ app_ok fun_ok primop_ok fun args -- see Note [exprOkForSpeculation and evaluated variables] where fun_ty = idType fun - n_val_args = valArgCount args + n_val_args = length val_args (arg_tys, _) = splitPiTys fun_ty + val_arg_tys = mapMaybe anonPiTyBinderType_maybe arg_tys -- Used for arguments to primops and to partial applications - arg_ok :: PiTyVarBinder -> CoreExpr -> Bool - arg_ok (Named _) _ = True -- A type argument - arg_ok (Anon ty _) arg -- A term argument - | definitelyLiftedType (scaledThing ty) + arg_ok :: Type -> CoreExpr -> Bool + arg_ok ty arg + | definitelyLiftedType ty = True -- See Note [Primops with lifted arguments] | otherwise = expr_ok fun_ok primop_ok arg + -- Used for DataCon worker arguments + field_ok :: StrictnessMark -> Type -> CoreExpr -> Bool + field_ok str ty arg -- A term argument + | NotMarkedStrict <- str -- iff it's a lazy field + , definitelyLiftedType ty -- and its type is lifted + = True -- then the worker app does not eval + | otherwise + = expr_ok fun_ok primop_ok arg + ----------------------------- altsAreExhaustive :: [Alt b] -> Bool -- True <=> the case alternatives are definitely exhaustive @@ -1937,12 +1933,14 @@ exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding -- or PAPs. -- exprIsHNFlike :: HasDebugCallStack => (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool -exprIsHNFlike is_con is_con_unf = is_hnf_like +exprIsHNFlike is_con is_con_unf e + = -- pprTraceWith "hnf" (\r -> ppr r <+> ppr e) $ + is_hnf_like e where is_hnf_like (Var v) -- NB: There are no value args at this point - = id_app_is_value v 0 -- Catches nullary constructors, - -- so that [] and () are values, for example - -- and (e.g.) primops that don't have unfoldings + = id_app_is_value v [] -- Catches nullary constructors, + -- so that [] and () are values, for example + -- and (e.g.) primops that don't have unfoldings || is_con_unf (idUnfolding v) -- Check the thing's unfolding; it might be bound to a value -- or to a guaranteed-evaluated variable (isEvaldUnfolding) @@ -1966,31 +1964,57 @@ exprIsHNFlike is_con is_con_unf = is_hnf_like -- See Note [exprIsHNF Tick] is_hnf_like (Cast e _) = is_hnf_like e is_hnf_like (App e a) - | isValArg a = app_is_value e 1 + | isValArg a = app_is_value e [a] | otherwise = is_hnf_like e is_hnf_like (Let _ e) = is_hnf_like e -- Lazy let(rec)s don't affect us is_hnf_like _ = False - -- 'n' is the number of value args to which the expression is applied - -- And n>0: there is at least one value argument - app_is_value :: CoreExpr -> Int -> Bool - app_is_value (Var f) nva = id_app_is_value f nva - app_is_value (Tick _ f) nva = app_is_value f nva - app_is_value (Cast f _) nva = app_is_value f nva - app_is_value (App f a) nva - | isValArg a = - app_is_value f (nva + 1) && - not (needsCaseBinding (exprType a) a) - -- For example f (x /# y) where f has arity two, and the first - -- argument is unboxed. This is not a value! - -- But f 34# is a value. - -- NB: Check app_is_value first, the arity check is cheaper - | otherwise = app_is_value f nva - app_is_value _ _ = False - - id_app_is_value id n_val_args - = is_con id - || idArity id > n_val_args + -- Collect arguments through Casts and Ticks and call id_app_is_value + app_is_value :: CoreExpr -> [CoreArg] -> Bool + app_is_value (Var f) as = id_app_is_value f as + app_is_value (Tick _ f) as = app_is_value f as + app_is_value (Cast f _) as = app_is_value f as + app_is_value (App f a) as | isValArg a = app_is_value f (a:as) + | otherwise = app_is_value f as + app_is_value _ _ = False + + id_app_is_value id val_args + -- First handle saturated applications of DataCons with strict fields + | Just dc <- isDataConWorkId_maybe id -- DataCon + , Just str_marks <- dataConRepStrictness_maybe dc -- with strict fields + , assert (val_args `leLength` str_marks) True + , val_args `equalLength` str_marks -- in a saturated app + = all3Prefix check_field str_marks val_arg_tys val_args + + -- Now all applications except saturated DataCon apps with strict fields + | idArity id > length val_args + -- PAP: Check unlifted val_args + || is_con id && isNothing (isDataConWorkId_maybe id >>= dataConRepStrictness_maybe) + -- Either a lazy DataCon or a CONLIKE. + -- Hence we only need to check unlifted val_args here. + -- NB: We assume that CONLIKEs are lazy, which is their entire + -- point. + = all2Prefix check_arg val_arg_tys val_args + + | otherwise + = False + where + fun_ty = idType id + (arg_tys,_) = splitPiTys fun_ty + val_arg_tys = mapMaybe anonPiTyBinderType_maybe arg_tys + -- val_arg_tys = map exprType val_args, but much less costly. + -- The obvious definition regresses T16577 by 30% so we don't do it. + + check_arg a_ty a = mightBeUnliftedType a_ty ==> is_hnf_like a + -- Check unliftedness; for example f (x /# 12#) where f has arity two, + -- and the first argument is unboxed. This is not a value! + -- But f 34# is a value, so check args for HNFs. + -- NB: We check arity (and CONLIKEness) first because it's cheaper + -- and we reject quickly on saturated apps. + check_field str a_ty a + = isMarkedStrict str || mightBeUnliftedType a_ty ==> is_hnf_like a + a ==> b = not a || b + infixr 1 ==> {- Note [exprIsHNF Tick] @@ -2551,7 +2575,7 @@ This means the seqs on x and y both become no-ops and compared to the first vers The downside is that the caller of $wfoo potentially has to evaluate `y` once if we can't prove it isn't already evaluated. But y coming out of a strict field is in WHNF so safe to evaluated. And most of the time it will be properly tagged+evaluated -already at the call site because of the Strict Field Invariant! See Note [Strict Field Invariant] for more in this. +already at the call site because of the Strict Field Invariant! See Note [STG Strict Field Invariant] for more in this. This makes GHC itself around 1% faster despite doing slightly more work! So this is generally quite good. We only apply this when we think there is a benefit in doing so however. There are a number of cases in which ===================================== compiler/GHC/Stg/InferTags.hs ===================================== @@ -64,8 +64,8 @@ With nofib being ~0.3% faster as well. See Note [Tag inference passes] for how we proceed to generate and use this information. -Note [Strict Field Invariant] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [STG Strict Field Invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As part of tag inference we introduce the Strict Field Invariant. Which consists of us saying that: @@ -124,15 +124,33 @@ Note that there are similar constraints around Note [CBV Function Ids]. Note [How untagged pointers can end up in strict fields] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Since the resolution of #20749 where Core passes assume that DataCon workers +evaluate their strict fields, it is pretty simple to see how the Simplifier +might exploit that knowledge to drop evals. Example: + + data MkT a = MkT !a + f :: [Int] -> T [Int] + f xs = xs `seq` MkT xs + +in Core we will have + + f = \xs -> MkT @[Int] xs + +No eval left there. + Consider data Set a = Tip | Bin !a (Set a) (Set a) We make a wrapper for Bin that evaluates its arguments $WBin x a b = case x of xv -> Bin xv a b Here `xv` will always be evaluated and properly tagged, just as the -Strict Field Invariant requires. +Note [STG Strict Field Invariant] requires. + +But alas, the Simplifier can destroy the invariant: see #15696. +Indeed, as Note [Strict fields in Core] explains, Core passes +assume that Data constructor workers evaluate their strict fields, +so the Simplifier will drop seqs freely. -But alas the Simplifier can destroy the invariant: see #15696. We start with thk = f () g x = ...(case thk of xv -> Bin xv Tip Tip)... @@ -153,7 +171,7 @@ Now you can see that the argument of Bin, namely thk, points to the thunk, not to the value as it did before. In short, although it may be rare, the output of optimisation passes -cannot guarantee to obey the Strict Field Invariant. For this reason +cannot guarantee to obey the Note [STG Strict Field Invariant]. For this reason we run tag inference. See Note [Tag inference passes]. Note [Tag inference passes] @@ -163,7 +181,7 @@ Tag inference proceeds in two passes: The result is then attached to /binders/. This is implemented by `inferTagsAnal` in GHC.Stg.InferTags * The second pass walks over the AST checking if the Strict Field Invariant is upheld. - See Note [Strict Field Invariant]. + See Note [STG Strict Field Invariant]. If required this pass modifies the program to uphold this invariant. Tag information is also moved from /binders/ to /occurrences/ during this pass. This is done by `GHC.Stg.InferTags.Rewrite (rewriteTopBinds)`. ===================================== compiler/GHC/Stg/InferTags/Rewrite.hs ===================================== @@ -64,7 +64,7 @@ The work of this pass is simple: * For any strict field we check if the argument is known to be properly tagged. * If it's not known to be properly tagged, we wrap the whole thing in a case, which will force the argument before allocation. -This is described in detail in Note [Strict Field Invariant]. +This is described in detail in Note [STG Strict Field Invariant]. The only slight complication is that we have to make sure not to invalidate free variable analysis in the process. @@ -217,7 +217,7 @@ When compiling bytecode we call myCoreToStg to get STG code first. myCoreToStg in turn calls out to stg2stg which runs the STG to STG passes followed by free variables analysis and the tag inference pass including it's rewriting phase at the end. -Running tag inference is important as it upholds Note [Strict Field Invariant]. +Running tag inference is important as it upholds Note [STG Strict Field Invariant]. While code executed by GHCi doesn't take advantage of the SFI it can call into compiled code which does. So it must still make sure that the SFI is upheld. See also #21083 and #22042. ===================================== compiler/GHC/Tc/TyCl/Build.hs ===================================== @@ -176,12 +176,13 @@ buildDataCon fam_envs dc_bang_opts src_name declared_infix prom_info src_bangs tag = lookupNameEnv_NF tag_map src_name -- See Note [Constructor tag allocation], fixes #14657 data_con = mkDataCon src_name declared_infix prom_info - src_bangs field_lbls + src_bangs impl_bangs str_marks field_lbls univ_tvs ex_tvs user_tvbs eq_spec ctxt arg_tys res_ty NoPromInfo rep_tycon tag stupid_ctxt dc_wrk dc_rep dc_wrk = mkDataConWorkId work_name data_con - dc_rep = initUs_ us (mkDataConRep dc_bang_opts fam_envs wrap_name data_con) + (dc_rep, impl_bangs, str_marks) = + initUs_ us (mkDataConRep dc_bang_opts fam_envs wrap_name data_con) ; traceIf (text "buildDataCon 2" <+> ppr src_name) ; return data_con } ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -1390,33 +1390,8 @@ arguments. That is the job of dmdTransformDataConSig. More precisely, * it returns the demands on the arguments; in the above example that is [SL, A] -Nasty wrinkle. Consider this code (#22475 has more realistic examples but -assume this is what the demand analyser sees) - - data T = MkT !Int Bool - get :: T -> Bool - get (MkT _ b) = b - - foo = let v::Int = I# 7 - t::T = MkT v True - in get t - -Now `v` is unused by `get`, /but/ we can't give `v` an Absent demand, -else we'll drop the binding and replace it with an error thunk. -Then the code generator (more specifically GHC.Stg.InferTags.Rewrite) -will add an extra eval of MkT's argument to give - foo = let v::Int = error "absent" - t::T = case v of v' -> MkT v' True - in get t - -Boo! Because of this extra eval (added in STG-land), the truth is that `MkT` -may (or may not) evaluate its arguments (as established in #21497). Hence the -use of `bump` in dmdTransformDataConSig, which adds in a `C_01` eval. The -`C_01` says "may or may not evaluate" which is absolutely faithful to what -InferTags.Rewrite does. - -In particular it is very important /not/ to make that a `C_11` eval, -see Note [Data-con worker strictness]. +When the data constructor worker has strict fields, they act as additional +seqs; hence we add an additional `C_11` eval. -} {- ********************************************************************* @@ -1616,6 +1591,29 @@ a bad fit because expression may not throw a precise exception (increasing precision of the analysis), but that's just a favourable guess. +Note [Side-effects and strictness] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Due to historic reasons and the continued effort not to cause performance +regressions downstream, Strictness Analysis is currently prone to discarding +observable side-effects (other than precise exceptions, see +Note [Precise exceptions and strictness analysis]) in some cases. For example, + f :: MVar () -> Int -> IO Int + f mv x = putMVar mv () >> (x `seq` return x) +The call to `putMVar` is an observable side-effect. Yet, Strictness Analysis +currently concludes that `f` is strict in `x` and uses call-by-value. +That means `f mv (error "boom")` will error out with the imprecise exception +rather performing the side-effect. + +This is a conscious violation of the semantics described in the paper +"a semantics for imprecise exceptions"; so it would be great if we could +identify the offending primops and extend the idea in +Note [Which scrutinees may throw precise exceptions] to general side-effects. + +Unfortunately, the existing has-side-effects classification for primops is +too conservative, listing `writeMutVar#` and even `readMutVar#` as +side-effecting. That is due to #3207. A possible way forward is described in +#17900, but no effort has been so far towards a resolution. + Note [Exceptions and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We used to smart about catching exceptions, but we aren't anymore. @@ -2326,7 +2324,7 @@ dmdTransformDataConSig str_marks sd = case viewProd arity body_sd of mk_body_ty n dmds = DmdType emptyDmdEnv (zipWith (bump n) str_marks dmds) topDiv bump n str dmd | isMarkedStrict str = multDmd n (plusDmd str_field_dmd dmd) | otherwise = multDmd n dmd - str_field_dmd = C_01 :* seqSubDmd -- Why not C_11? See Note [Data-con worker strictness] + str_field_dmd = C_11 :* seqSubDmd -- See Note [Strict fields in Core] -- | A special 'DmdTransformer' for dictionary selectors that feeds the demand -- on the result into the indicated dictionary component (if saturated). ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -220,7 +220,7 @@ The invariants around the arguments of call by value function like Ids are then: * Any `WorkerLikeId` * Some `JoinId` bindings. -This works analogous to the Strict Field Invariant. See also Note [Strict Field Invariant]. +This works analogous to the Strict Field Invariant. See also Note [STG Strict Field Invariant]. To make this work what we do is: * During W/W and SpecConstr any worker/specialized binding we introduce ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -56,7 +56,7 @@ import GHC.Core.Coercion import GHC.Core.Reduction import GHC.Core.Make import GHC.Core.FVs ( mkRuleInfo ) -import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, coreAltsType ) +import GHC.Core.Utils ( exprType, mkCast, coreAltsType ) import GHC.Core.Unfold.Make import GHC.Core.SimpleOpt import GHC.Core.TyCon @@ -586,8 +586,12 @@ mkDataConWorkId wkr_name data_con = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info where - tycon = dataConTyCon data_con -- The representation TyCon - wkr_ty = dataConRepType data_con + tycon = dataConTyCon data_con -- The representation TyCon + wkr_ty = dataConRepType data_con + univ_tvs = dataConUnivTyVars data_con + ex_tcvs = dataConExTyCoVars data_con + arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys + str_marks = dataConRepStrictness data_con ----------- Workers for data types -------------- alg_wkr_info = noCafIdInfo @@ -595,15 +599,19 @@ mkDataConWorkId wkr_name data_con `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 - -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon + `setDmdSigInfo` wkr_sig + -- Workers eval their strict fields + -- See Note [Strict fields in Core] wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + wkr_sig = mkClosedDmdSig wkr_dmds topDiv + wkr_dmds = map mk_dmd str_marks + mk_dmd MarkedStrict = evalDmd + mk_dmd NotMarkedStrict = topDmd + ----------- Workers for newtypes -------------- - univ_tvs = dataConUnivTyVars data_con - ex_tcvs = dataConExTyCoVars data_con - arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo `setArityInfo` 1 -- Arity 1 `setInlinePragInfo` dataConWrapperInlinePragma @@ -686,10 +694,10 @@ mkDataConRep :: DataConBangOpts -> FamInstEnvs -> Name -> DataCon - -> UniqSM DataConRep + -> UniqSM (DataConRep, [HsImplBang], [StrictnessMark]) mkDataConRep dc_bang_opts fam_envs wrap_name data_con | not wrapper_reqd - = return NoDataConRep + = return (NoDataConRep, arg_ibangs, rep_strs) | otherwise = do { wrap_args <- mapM (newLocal (fsLit "conrep")) wrap_arg_tys @@ -744,11 +752,8 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con ; return (DCR { dcr_wrap_id = wrap_id , dcr_boxer = mk_boxer boxers - , dcr_arg_tys = rep_tys - , dcr_stricts = rep_strs - -- For newtypes, dcr_bangs is always [HsLazy]. - -- See Note [HsImplBangs for newtypes]. - , dcr_bangs = arg_ibangs }) } + , dcr_arg_tys = rep_tys } + , arg_ibangs, rep_strs) } where (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty) @@ -798,8 +803,8 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con -- (Most) newtypes have only a worker, with the exception -- of some newtypes written with GADT syntax. -- See dataConUserTyVarsNeedWrapper below. - && (any isBanged (ev_ibangs ++ arg_ibangs))) - -- Some forcing/unboxing (includes eq_spec) + && (any isUnpacked (ev_ibangs ++ arg_ibangs))) + -- Some unboxing (includes eq_spec) || isFamInstTyCon tycon -- Cast result || (dataConUserTyVarsNeedWrapper data_con -- If the data type was written with GADT syntax and @@ -1077,7 +1082,7 @@ dataConArgRep arg_ty HsLazy = ([(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer)) dataConArgRep arg_ty (HsStrict _) - = ([(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer)) + = ([(arg_ty, MarkedStrict)], (unitUnboxer, unitBoxer)) -- Seqs are inserted in STG dataConArgRep arg_ty (HsUnpack Nothing) = dataConArgUnpack arg_ty @@ -1107,9 +1112,6 @@ wrapCo co rep_ty (unbox_rep, box_rep) -- co :: arg_ty ~ rep_ty ; return (rep_ids, rep_expr `Cast` mkSymCo sco) } ------------------------ -seqUnboxer :: Unboxer -seqUnboxer v = return ([v], mkDefaultCase (Var v) v) - unitUnboxer :: Unboxer unitUnboxer v = return ([v], \e -> e) ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Utils.Misc ( dropWhileEndLE, spanEnd, last2, lastMaybe, onJust, - List.foldl1', foldl2, count, countWhile, all2, + List.foldl1', foldl2, count, countWhile, all2, all2Prefix, all3Prefix, lengthExceeds, lengthIs, lengthIsNot, lengthAtLeast, lengthAtMost, lengthLessThan, @@ -646,6 +646,25 @@ all2 _ [] [] = True all2 p (x:xs) (y:ys) = p x y && all2 p xs ys all2 _ _ _ = False +all2Prefix :: (a -> b -> Bool) -> [a] -> [b] -> Bool +-- ^ `all2Prefix p xs ys` is a fused version of `and $ zipWith2 p xs ys`. +-- So if one list is shorter than the other, `p` is assumed to be `True` for the +-- suffix. +all2Prefix p xs ys = go xs ys + where go (x:xs) (y:ys) = p x y && go xs ys + go _ _ = True +{-# INLINABLE all2Prefix #-} + +all3Prefix :: (a -> b -> c -> Bool) -> [a] -> [b] -> [c] -> Bool +-- ^ `all3Prefix p xs ys zs` is a fused version of `and $ zipWith3 p xs ys zs`. +-- So if one list is shorter than the others, `p` is assumed to be `True` for +-- the suffix. +all3Prefix p xs ys zs = go xs ys zs + where + go (x:xs) (y:ys) (z:zs) = p x y z && go xs ys zs + go _ _ _ = True +{-# INLINABLE all3Prefix #-} + -- Count the number of times a predicate is true count :: (a -> Bool) -> [a] -> Int ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -17,6 +17,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: Class op . (BUILTIN) @@ -25,6 +27,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Arrow (BUILTIN) Rule fired: Class op $p1Arrow (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) @@ -38,6 +42,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op first (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op >>= (BUILTIN) @@ -48,6 +54,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @(_, ()) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: Class op . (BUILTIN) @@ -56,6 +64,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op . (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op $p1Applicative (BUILTIN) @@ -70,6 +80,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Arrow (BUILTIN) Rule fired: Class op $p1Arrow (BUILTIN) Rule fired: Class op id (BUILTIN) @@ -83,6 +95,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op ||| (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op $p1Applicative (BUILTIN) @@ -98,6 +112,8 @@ Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) +Rule fired: mkRule @((), _) (T18013a) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Monad (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: Class op . (BUILTIN) @@ -108,22 +124,6 @@ Rule fired: Class op >>= (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: mkRule @((), _) (T18013a) Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @(_, ()) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) -Rule fired: mkRule @((), _) (T18013a) -Rule fired: Class op fmap (BUILTIN) Rule fired: mkRule @(_, ()) (T18013a) Rule fired: Class op fmap (BUILTIN) Rule fired: mkRule @(_, ()) (T18013a) @@ -138,9 +138,9 @@ mapMaybeRule [InlPrag=[2]] :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b) [GblId, Arity=1, - Str=<1!P(L,LC(S,C(1,C(1,P(L,1L)))))>, - Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, + Str=<1!P(SL,LC(S,C(1,C(1,P(L,1L)))))>, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@b) (f [Occ=Once1!] :: Rule IO a b) -> case f of { Rule @s ww ww1 [Occ=OnceL1!] -> @@ -219,36 +219,41 @@ mapMaybeRule -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18013.$trModule4 :: GHC.Prim.Addr# [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 20 0}] T18013.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T18013.$trModule3 :: GHC.Types.TrName [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T18013.$trModule3 = GHC.Types.TrNameS T18013.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T18013.$trModule2 :: GHC.Prim.Addr# [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 30 0}] T18013.$trModule2 = "T18013"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T18013.$trModule1 :: GHC.Types.TrName [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T18013.$trModule1 = GHC.Types.TrNameS T18013.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T18013.$trModule :: GHC.Types.Module [GblId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T18013.$trModule = GHC.Types.Module T18013.$trModule3 T18013.$trModule1 ===================================== testsuite/tests/simplCore/should_compile/T23083.hs ===================================== @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +module T23083 where + +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +g f h = f (h `seq` (h $)) ===================================== testsuite/tests/simplCore/should_compile/T23083.stderr ===================================== @@ -0,0 +1,36 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 21, types: 17, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 6, types: 6, coercions: 0, joins: 0/0} +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +[GblId, Arity=2, Str=<1C(1,L)>, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60] 50 0}] +g = \ (f :: (Integer -> Integer) -> Integer) (h :: Integer -> Integer) -> f (\ (eta :: Integer) -> h eta) + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule4 :: GHC.Prim.Addr# +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T23083.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule3 :: GHC.Types.TrName +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule3 = GHC.Types.TrNameS T23083.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule2 :: GHC.Prim.Addr# +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T23083.$trModule2 = "T23083"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule1 :: GHC.Types.TrName +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule1 = GHC.Types.TrNameS T23083.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule :: GHC.Types.Module +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule = GHC.Types.Module T23083.$trModule3 T23083.$trModule1 + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -417,7 +417,10 @@ test('T21391', normal, compile, ['-O -dcore-lint']) test('T22112', normal, compile, ['-O -dsuppress-uniques -dno-typeable-binds -ddump-simpl']) test('T21391a', normal, compile, ['-O -dcore-lint']) # We don't want to see a thunk allocation for the insertBy expression after CorePrep. -test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]'), expect_broken(21392) ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques']) +# Unfortunately, this test is no longer broken after we made workers strict in strict fields, +# so it is no longer a reproducer for T21392. Still, it doesn't hurt if we test that we don't +# regress again. +test('T21392', [ grep_errmsg(r'sat.* :: \[\(.*Unique, .*Int\)\]') ], compile, ['-O -ddump-prep -dno-typeable-binds -dsuppress-uniques']) test('T21689', [extra_files(['T21689a.hs'])], multimod_compile, ['T21689', '-v0 -O']) test('T21801', normal, compile, ['-O -dcore-lint']) test('T21848', [grep_errmsg(r'SPEC wombat') ], compile, ['-O -ddump-spec']) @@ -476,3 +479,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) +test('T23083', [ grep_errmsg(r'f.*eta') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dppr-cols=99999']) ===================================== testsuite/tests/simplStg/should_compile/inferTags002.stderr ===================================== @@ -1,88 +1,30 @@ -==================== Output Cmm ==================== -[M.$WMkT_entry() { // [R3, R2] - { info_tbls: [(cym, - label: block_cym_info - rep: StackRep [False] - srt: Nothing), - (cyp, - label: M.$WMkT_info - rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 15} } - srt: Nothing), - (cys, - label: block_cys_info - rep: StackRep [False] - srt: Nothing)] - stack_info: arg_space: 8 - } - {offset - cyp: // global - if ((Sp + -16) < SpLim) (likely: False) goto cyv; else goto cyw; - cyv: // global - R1 = M.$WMkT_closure; - call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8; - cyw: // global - I64[Sp - 16] = cym; - R1 = R2; - P64[Sp - 8] = R3; - Sp = Sp - 16; - if (R1 & 7 != 0) goto cym; else goto cyn; - cyn: // global - call (I64[R1])(R1) returns to cym, args: 8, res: 8, upd: 8; - cym: // global - I64[Sp] = cys; - _sy8::P64 = R1; - R1 = P64[Sp + 8]; - P64[Sp + 8] = _sy8::P64; - call stg_ap_0_fast(R1) returns to cys, args: 8, res: 8, upd: 8; - cys: // global - Hp = Hp + 24; - if (Hp > HpLim) (likely: False) goto cyA; else goto cyz; - cyA: // global - HpAlloc = 24; - call stg_gc_unpt_r1(R1) returns to cys, args: 8, res: 8, upd: 8; - cyz: // global - I64[Hp - 16] = M.MkT_con_info; - P64[Hp - 8] = P64[Sp + 8]; - P64[Hp] = R1; - R1 = Hp - 15; - Sp = Sp + 16; - call (P64[Sp])(R1) args: 8, res: 0, upd: 8; - } - }, - section ""data" . M.$WMkT_closure" { - M.$WMkT_closure: - const M.$WMkT_info; - }] - - - ==================== Output Cmm ==================== [M.f_entry() { // [R2] - { info_tbls: [(cyK, - label: block_cyK_info + { info_tbls: [(cAs, + label: block_info rep: StackRep [] srt: Nothing), - (cyN, + (cAv, label: M.f_info rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} } srt: Nothing)] stack_info: arg_space: 8 } {offset - cyN: // global - if ((Sp + -8) < SpLim) (likely: False) goto cyO; else goto cyP; - cyO: // global + _lbl_: // global + if ((Sp + -8) < SpLim) (likely: False) goto cAw; else goto cAx; + _lbl_: // global R1 = M.f_closure; call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8; - cyP: // global - I64[Sp - 8] = cyK; + _lbl_: // global + I64[Sp - 8] = cAs; R1 = R2; Sp = Sp - 8; - if (R1 & 7 != 0) goto cyK; else goto cyL; - cyL: // global - call (I64[R1])(R1) returns to cyK, args: 8, res: 8, upd: 8; - cyK: // global + if (R1 & 7 != 0) goto cAs; else goto cAt; + _lbl_: // global + call (I64[R1])(R1) returns to cAs, args: 8, res: 8, upd: 8; + _lbl_: // global R1 = P64[R1 + 15]; Sp = Sp + 8; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; @@ -97,47 +39,47 @@ ==================== Output Cmm ==================== [M.MkT_entry() { // [R3, R2] - { info_tbls: [(cz1, - label: block_cz1_info + { info_tbls: [(cAJ, + label: block_info rep: StackRep [False] srt: Nothing), - (cz4, + (cAM, label: M.MkT_info rep: HeapRep static { Fun {arity: 2 fun_type: ArgSpec 15} } srt: Nothing), - (cz7, - label: block_cz7_info + (cAP, + label: block_info rep: StackRep [False] srt: Nothing)] stack_info: arg_space: 8 } {offset - cz4: // global - if ((Sp + -16) < SpLim) (likely: False) goto cza; else goto czb; - cza: // global + _lbl_: // global + if ((Sp + -16) < SpLim) (likely: False) goto cAS; else goto cAT; + _lbl_: // global R1 = M.MkT_closure; call (stg_gc_fun)(R3, R2, R1) args: 8, res: 0, upd: 8; - czb: // global - I64[Sp - 16] = cz1; + _lbl_: // global + I64[Sp - 16] = cAJ; R1 = R2; P64[Sp - 8] = R3; Sp = Sp - 16; - if (R1 & 7 != 0) goto cz1; else goto cz2; - cz2: // global - call (I64[R1])(R1) returns to cz1, args: 8, res: 8, upd: 8; - cz1: // global - I64[Sp] = cz7; - _tyf::P64 = R1; + if (R1 & 7 != 0) goto cAJ; else goto cAK; + _lbl_: // global + call (I64[R1])(R1) returns to cAJ, args: 8, res: 8, upd: 8; + _lbl_: // global + I64[Sp] = cAP; + __locVar_::P64 = R1; R1 = P64[Sp + 8]; - P64[Sp + 8] = _tyf::P64; - call stg_ap_0_fast(R1) returns to cz7, args: 8, res: 8, upd: 8; - cz7: // global + P64[Sp + 8] = __locVar_::P64; + call stg_ap_0_fast(R1) returns to cAP, args: 8, res: 8, upd: 8; + _lbl_: // global Hp = Hp + 24; - if (Hp > HpLim) (likely: False) goto czf; else goto cze; - czf: // global + if (Hp > HpLim) (likely: False) goto cAX; else goto cAW; + _lbl_: // global HpAlloc = 24; - call stg_gc_unpt_r1(R1) returns to cz7, args: 8, res: 8, upd: 8; - cze: // global + call stg_gc_unpt_r1(R1) returns to cAP, args: 8, res: 8, upd: 8; + _lbl_: // global I64[Hp - 16] = M.MkT_con_info; P64[Hp - 8] = P64[Sp + 8]; P64[Hp] = R1; @@ -155,14 +97,14 @@ ==================== Output Cmm ==================== [M.MkT_con_entry() { // [] - { info_tbls: [(czl, + { info_tbls: [(cB3, label: M.MkT_con_info rep: HeapRep 2 ptrs { Con {tag: 0 descr:"main:M.MkT"} } srt: Nothing)] stack_info: arg_space: 8 } {offset - czl: // global + _lbl_: // global R1 = R1 + 1; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; } ===================================== testsuite/tests/stranal/sigs/T16859.stderr ===================================== @@ -4,7 +4,7 @@ T16859.bar: <1!A> T16859.baz: <1L><1!P(L)><1C(1,L)> T16859.buz: <1!P(L,L)> T16859.foo: <1L> -T16859.mkInternalName: <1!P(L)><1L><1L> +T16859.mkInternalName: <1!P(L)> T16859.n_loc: <1!P(A,A,A,1L)> T16859.n_occ: <1!P(A,1!P(L,L),A,A)> T16859.n_sort: <1!P(1L,A,A,A)> View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/964dbea3d708012ecae9077c9e4faa4c88e34a0d...beb2ed53d13d8c0d662c2bef182a9cfe490a6448 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/964dbea3d708012ecae9077c9e4faa4c88e34a0d...beb2ed53d13d8c0d662c2bef182a9cfe490a6448 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 13:29:39 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Tue, 07 Mar 2023 08:29:39 -0500 Subject: [Git][ghc/ghc][wip/T23083] Simplifier: Eta expand arguments (#23083) Message-ID: <64073c43af497_2c78e93678b64134111@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: d81cad21 by Sebastian Graf at 2023-03-07T14:28:40+01:00 Simplifier: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` Tweaking the Simplifier to eta-expand in args was a bit more painful than expected: * `tryEtaExpandRhs` and `findRhsArity` previously only worked on bindings. But eta expansion of non-recursive bindings is morally the same as eta expansion of arguments. And in fact the binder was never really looked at in the non-recursive case. I was able to make `findRhsArity` cater for both arguments and bindings, as well as have a new function `tryEtaExpandArg` that shares most of its code with that of `tryEtaExpandRhs`. * The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`, which seems to be the main way to simplify args. Hence I consolidated the code path to call `simplArg`, too, renaming to `simplLazyArg`. Fixes #23083. - - - - - 7 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Stats.hs - + testsuite/tests/simplCore/should_compile/T23083.hs - + testsuite/tests/simplCore/should_compile/T23083.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -872,9 +872,16 @@ exprEtaExpandArity opts e * * ********************************************************************* -} -findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr - -> (Bool, SafeArityType) --- This implements the fixpoint loop for arity analysis +findRhsArity + :: ArityOpts + -> Maybe Id -- ^ `Just bndr` when it's a recursive RHS bound by bndr + -> Bool -- ^ Is it a join binding? + -> [OneShotInfo] -- ^ The one-shot info from the use sites, perhaps from + -- `idDemandOneShots` of the binder + -> CoreExpr -- ^ The RHS (or argument expression) + -> Type -- ^ Type of the CoreExpr + -> (Bool, SafeArityType) +-- ^ This implements the fixpoint loop for arity analysis -- See Note [Arity analysis] -- -- The Bool is True if the returned arity is greater than (exprArity rhs) @@ -884,8 +891,8 @@ findRhsArity :: ArityOpts -> RecFlag -> Id -> CoreExpr -- Returns an SafeArityType that is guaranteed trimmed to typeArity of 'bndr' -- See Note [Arity trimming] -findRhsArity opts is_rec bndr rhs - | isJoinId bndr +findRhsArity opts mb_rec_bndr is_join use_one_shots rhs rhs_ty + | is_join = (False, join_arity_type) -- False: see Note [Do not eta-expand join points] -- But do return the correct arity and bottom-ness, because @@ -900,28 +907,27 @@ findRhsArity opts is_rec bndr rhs old_arity = exprArity rhs init_env :: ArityEnv - init_env = findRhsArityEnv opts (isJoinId bndr) + init_env = findRhsArityEnv opts is_join -- Non-join-points only - non_join_arity_type = case is_rec of - Recursive -> go 0 botArityType - NonRecursive -> step init_env + non_join_arity_type = case mb_rec_bndr of + Just bndr -> go 0 bndr botArityType + Nothing -> step init_env arity_increased = arityTypeArity non_join_arity_type > old_arity -- Join-points only -- See Note [Arity for non-recursive join bindings] -- and Note [Arity for recursive join bindings] - join_arity_type = case is_rec of - Recursive -> go 0 botArityType - NonRecursive -> trimArityType ty_arity (cheapArityType rhs) + join_arity_type = case mb_rec_bndr of + Just bndr -> go 0 bndr botArityType + Nothing -> trimArityType ty_arity (cheapArityType rhs) - ty_arity = typeArity (idType bndr) - id_one_shots = idDemandOneShots bndr + ty_arity = typeArity rhs_ty step :: ArityEnv -> SafeArityType step env = trimArityType ty_arity $ safeArityType $ -- See Note [Arity invariants for bindings], item (3) - arityType env rhs `combineWithDemandOneShots` id_one_shots + arityType env rhs `combineWithDemandOneShots` use_one_shots -- trimArityType: see Note [Trim arity inside the loop] -- combineWithDemandOneShots: take account of the demand on the -- binder. Perhaps it is always called with 2 args @@ -934,8 +940,8 @@ findRhsArity opts is_rec bndr rhs -- is assumed to be sound. In other words, arities should never -- decrease. Result: the common case is that there is just one -- iteration - go :: Int -> SafeArityType -> SafeArityType - go !n cur_at@(AT lams div) + go :: Int -> Id -> SafeArityType -> SafeArityType + go !n bndr cur_at@(AT lams div) | not (isDeadEndDiv div) -- the "stop right away" case , length lams <= old_arity = cur_at -- from above | next_at == cur_at = cur_at @@ -944,7 +950,7 @@ findRhsArity opts is_rec bndr rhs = warnPprTrace (debugIsOn && n > 2) "Exciting arity" (nest 2 (ppr bndr <+> ppr cur_at <+> ppr next_at $$ ppr rhs)) $ - go (n+1) next_at + go (n+1) bndr next_at where next_at = step (extendSigEnv init_env bndr cur_at) @@ -964,30 +970,6 @@ combineWithDemandOneShots at@(AT lams div) oss zip_lams ((ch,os1):lams) (os2:oss) = (ch, os1 `bestOneShot` os2) : zip_lams lams oss -idDemandOneShots :: Id -> [OneShotInfo] -idDemandOneShots bndr - = call_arity_one_shots `zip_lams` dmd_one_shots - where - call_arity_one_shots :: [OneShotInfo] - call_arity_one_shots - | call_arity == 0 = [] - | otherwise = NoOneShotInfo : replicate (call_arity-1) OneShotLam - -- Call Arity analysis says the function is always called - -- applied to this many arguments. The first NoOneShotInfo is because - -- if Call Arity says "always applied to 3 args" then the one-shot info - -- we get is [NoOneShotInfo, OneShotLam, OneShotLam] - call_arity = idCallArity bndr - - dmd_one_shots :: [OneShotInfo] - -- If the demand info is C(x,C(1,C(1,.))) then we know that an - -- application to one arg is also an application to three - dmd_one_shots = argOneShots (idDemandInfo bndr) - - -- Take the *longer* list - zip_lams (lam1:lams1) (lam2:lams2) = (lam1 `bestOneShot` lam2) : zip_lams lams1 lams2 - zip_lams [] lams2 = lams2 - zip_lams lams1 [] = lams1 - {- Note [Arity analysis] ~~~~~~~~~~~~~~~~~~~~~~~~ The motivating example for arity analysis is this: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -1517,7 +1517,7 @@ rebuild env expr cont ApplyToVal { sc_arg = arg, sc_env = se, sc_dup = dup_flag , sc_cont = cont, sc_hole_ty = fun_ty } -- See Note [Avoid redundant simplification] - -> do { (_, _, arg') <- simplArg env dup_flag fun_ty se arg + -> do { (_, _, arg') <- simplLazyArg env dup_flag fun_ty Nothing topDmd se arg ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv @@ -1633,7 +1633,6 @@ simplCast env body co0 cont0 , sc_hole_ty = coercionLKind co }) } -- NB! As the cast goes past, the -- type of the hole changes (#16312) - -- (f |> co) e ===> (f (e |> co1)) |> co2 -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 @@ -1652,7 +1651,7 @@ simplCast env body co0 cont0 -- See Note [Avoiding exponential behaviour] MCo co1 -> - do { (dup', arg_se', arg') <- simplArg env dup fun_ty arg_se arg + do { (dup', arg_se', arg') <- simplLazyArg env dup fun_ty Nothing topDmd arg_se arg -- When we build the ApplyTo we can't mix the OutCoercion -- 'co' with the InExpr 'arg', so we simplify -- to make it all consistent. It's a bit messy. @@ -1678,17 +1677,21 @@ simplCast env body co0 cont0 -- See Note [Representation polymorphism invariants] in GHC.Core -- test: typecheck/should_run/EtaExpandLevPoly -simplArg :: SimplEnv -> DupFlag - -> OutType -- Type of the function applied to this arg - -> StaticEnv -> CoreExpr -- Expression with its static envt - -> SimplM (DupFlag, StaticEnv, OutExpr) -simplArg env dup_flag fun_ty arg_env arg +simplLazyArg :: SimplEnv -> DupFlag + -> OutType -- Type of the function applied to this arg + -> Maybe ArgInfo + -> Demand -- Demand on the argument expr + -> StaticEnv -> CoreExpr -- Expression with its static envt + -> SimplM (DupFlag, StaticEnv, OutExpr) +simplLazyArg env dup_flag fun_ty mb_arg_info arg_dmd arg_env arg | isSimplified dup_flag = return (dup_flag, arg_env, arg) | otherwise = do { let arg_env' = arg_env `setInScopeFromE` env - ; arg' <- simplExprC arg_env' arg (mkBoringStop (funArgTy fun_ty)) - ; return (Simplified, zapSubstEnv arg_env', arg') } + ; let arg_ty = funArgTy fun_ty + ; arg1 <- simplExprC arg_env' arg (mkLazyArgStop arg_ty mb_arg_info) + ; (_arity_type, arg2) <- tryEtaExpandArg env arg_dmd arg1 arg_ty + ; return (Simplified, zapSubstEnv arg_env', arg2) } -- Return a StaticEnv that includes the in-scope set from 'env', -- because arg' may well mention those variables (#20639) @@ -2281,12 +2284,9 @@ rebuildCall env fun_info -- There is no benefit (unlike in a let-binding), and we'd -- have to be very careful about bogus strictness through -- floating a demanded let. - = do { arg' <- simplExprC (arg_se `setInScopeFromE` env) arg - (mkLazyArgStop arg_ty fun_info) + = do { let (dmd:_) = ai_dmds fun_info + ; (_, _, arg') <- simplLazyArg env dup_flag fun_ty (Just fun_info) dmd arg_se arg ; rebuildCall env (addValArgTo fun_info arg' fun_ty) cont } - where - arg_ty = funArgTy fun_ty - ---------- No further useful info, revert to generic rebuild ------------ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont @@ -3723,7 +3723,7 @@ mkDupableContWithDmds env dmds do { let (dmd:cont_dmds) = dmds -- Never fails ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 - ; (_, se', arg') <- simplArg env' dup hole_ty se arg + ; (_, se', arg') <- simplLazyArg env' dup hole_ty Nothing dmd se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ; let all_floats = floats1 `addLetFloats` let_floats2 ; return ( all_floats ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -9,7 +9,7 @@ The simplifier utilities module GHC.Core.Opt.Simplify.Utils ( -- Rebuilding rebuildLam, mkCase, prepareAlts, - tryEtaExpandRhs, wantEtaExpansion, + tryEtaExpandRhs, tryEtaExpandArg, wantEtaExpansion, -- Inlining, preInlineUnconditionally, postInlineUnconditionally, @@ -461,8 +461,9 @@ mkRhsStop :: OutType -> RecFlag -> Demand -> SimplCont -- See Note [RHS of lets] in GHC.Core.Unfold mkRhsStop ty is_rec bndr_dmd = Stop ty (RhsCtxt is_rec) (subDemandIfEvaluated bndr_dmd) -mkLazyArgStop :: OutType -> ArgInfo -> SimplCont -mkLazyArgStop ty fun_info = Stop ty (lazyArgContext fun_info) arg_sd +mkLazyArgStop :: OutType -> Maybe ArgInfo -> SimplCont +mkLazyArgStop ty Nothing = mkBoringStop ty +mkLazyArgStop ty (Just fun_info) = Stop ty (lazyArgContext fun_info) arg_sd where arg_sd = subDemandIfEvaluated (Partial.head (ai_dmds fun_info)) @@ -1738,7 +1739,7 @@ rebuildLam env bndrs@(bndr:_) body cont , seEtaExpand env , any isRuntimeVar bndrs -- Only when there is at least one value lambda already , Just body_arity <- exprEtaExpandArity (seArityOpts env) body - = do { tick (EtaExpansion bndr) + = do { tick (EtaExpansion Nothing) ; let body' = etaExpandAT in_scope body_arity body ; traceSmpl "eta expand" (vcat [text "before" <+> ppr body , text "after" <+> ppr body']) @@ -1859,15 +1860,39 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpandRhs env bind_cxt bndr rhs + = tryEtaExpandArgOrRhs env mb_rec_bndr (isJoinBC bind_cxt) + (idDemandOneShots bndr) rhs (idType bndr) + where + mb_rec_bndr = case bindContextRec bind_cxt of + Recursive -> Just bndr + NonRecursive -> Nothing + +tryEtaExpandArg :: SimplEnv -> Demand -> OutExpr -> OutType + -> SimplM (ArityType, OutExpr) +-- See Note [Eta-expanding at let bindings] +tryEtaExpandArg env arg_dmd arg arg_ty + = tryEtaExpandArgOrRhs env Nothing False (argOneShots arg_dmd) arg arg_ty + +tryEtaExpandArgOrRhs + :: SimplEnv + -> Maybe OutId -- ^ `Just bndr` when it's a recursive RHS bound by bndr + -> Bool -- ^ Is it a join binding? + -> [OneShotInfo] -- ^ The one-shot info from the use sites, perhaps from + -- `idDemandOneShots` of the binder + -> OutExpr -- ^ The RHS (or argument expression) + -> OutType -- ^ Type of the CoreExpr + -> SimplM (ArityType, OutExpr) +-- See Note [Eta-expanding at let bindings] +tryEtaExpandArgOrRhs env mb_rec_bndr is_join use_one_shots rhs rhs_ty | do_eta_expand -- If the current manifest arity isn't enough -- (never true for join points) , seEtaExpand env -- and eta-expansion is on , wantEtaExpansion rhs = -- Do eta-expansion. - assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ + assertPpr( not is_join ) (ppr mb_rec_bndr) $ -- assert: this never happens for join points; see GHC.Core.Opt.Arity -- Note [Do not eta-expand join points] - do { tick (EtaExpansion bndr) + do { tick (EtaExpansion mb_rec_bndr) ; return (arity_type, etaExpandAT in_scope arity_type rhs) } | otherwise @@ -1876,8 +1901,7 @@ tryEtaExpandRhs env bind_cxt bndr rhs where in_scope = getInScope env arity_opts = seArityOpts env - is_rec = bindContextRec bind_cxt - (do_eta_expand, arity_type) = findRhsArity arity_opts is_rec bndr rhs + (do_eta_expand, arity_type) = findRhsArity arity_opts mb_rec_bndr is_join use_one_shots rhs rhs_ty wantEtaExpansion :: CoreExpr -> Bool -- Mostly True; but False of PAPs which will immediately eta-reduce again @@ -1890,6 +1914,30 @@ wantEtaExpansion (Var {}) = False wantEtaExpansion (Lit {}) = False wantEtaExpansion _ = True +idDemandOneShots :: Id -> [OneShotInfo] +idDemandOneShots bndr + = call_arity_one_shots `zip_lams` dmd_one_shots + where + call_arity_one_shots :: [OneShotInfo] + call_arity_one_shots + | call_arity == 0 = [] + | otherwise = NoOneShotInfo : replicate (call_arity-1) OneShotLam + -- Call Arity analysis says the function is always called + -- applied to this many arguments. The first NoOneShotInfo is because + -- if Call Arity says "always applied to 3 args" then the one-shot info + -- we get is [NoOneShotInfo, OneShotLam, OneShotLam] + call_arity = idCallArity bndr + + dmd_one_shots :: [OneShotInfo] + -- If the demand info is C(x,C(1,C(1,.))) then we know that an + -- application to one arg is also an application to three + dmd_one_shots = argOneShots (idDemandInfo bndr) + + -- Take the *longer* list + zip_lams (lam1:lams1) (lam2:lams2) = (lam1 `bestOneShot` lam2) : zip_lams lams1 lams2 + zip_lams [] lams2 = lams2 + zip_lams lams1 [] = lams1 + {- Note [Eta-expanding at let bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Stats.hs ===================================== @@ -226,7 +226,7 @@ data Tick -- See Note [Which transformations are innocuous] | RuleFired FastString -- Rule name | LetFloatFromLet - | EtaExpansion Id -- LHS binder + | EtaExpansion (Maybe Id) -- LHS binder, if recursive | EtaReduction Id -- Binder on outer lambda | BetaReduction Id -- Lambda binder ===================================== testsuite/tests/simplCore/should_compile/T23083.hs ===================================== @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +module T23083 where + +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +g f h = f (h `seq` (h $)) ===================================== testsuite/tests/simplCore/should_compile/T23083.stderr ===================================== @@ -0,0 +1,36 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 21, types: 17, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 6, types: 6, coercions: 0, joins: 0/0} +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +[GblId, Arity=2, Str=<1C(1,L)>, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60] 50 0}] +g = \ (f :: (Integer -> Integer) -> Integer) (h :: Integer -> Integer) -> f (\ (eta :: Integer) -> h eta) + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule4 :: GHC.Prim.Addr# +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T23083.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule3 :: GHC.Types.TrName +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule3 = GHC.Types.TrNameS T23083.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule2 :: GHC.Prim.Addr# +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T23083.$trModule2 = "T23083"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule1 :: GHC.Types.TrName +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule1 = GHC.Types.TrNameS T23083.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule :: GHC.Types.Module +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule = GHC.Types.Module T23083.$trModule3 T23083.$trModule1 + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -476,3 +476,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) +test('T23083', [ grep_errmsg(r'f.*eta') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dppr-cols=99999']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d81cad21a5a05b06d3a2413fc7400eba2548cbd6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d81cad21a5a05b06d3a2413fc7400eba2548cbd6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 15:51:23 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 07 Mar 2023 10:51:23 -0500 Subject: [Git][ghc/ghc][wip/T23051] 15 commits: Enable response files for linker if supported Message-ID: <64075d7b6f510_2c78e964862e02266ac@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23051 at Glasgow Haskell Compiler / GHC Commits: 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - c952d1b8 by Simon Peyton Jones at 2023-03-07T15:52:39+00:00 Comments and tc-trace only - - - - - 847418b2 by Simon Peyton Jones at 2023-03-07T15:52:39+00:00 Be more careful about quantification This MR is driven by #23051. It does several things: * Never quantify over concrete type variables An extra guard in GHC.Tc.Utils.TcMType.collect_cand_qtvs * Never quantify over variables free in the kind of the type(s) being generalised. This is done in GHC.Tc.Solver.decideMonoTyVars, by adding `kind_vars` to `mono_tvs`. * When generalising a term in tcSimplifyInfer, move the promotion of `mono_tyvars` from `defaultTyVarsAndSimplify` to `decideMonoTyVars`. This is a no-op; just tidies up the code. * Get rid of the un-motivated (and I think unnecessary) blah about SkolemTv in collect_cand_qtvs. Needs documentation etc. Currently wanting this MR for CI. - - - - - 4e5a5291 by Simon Peyton Jones at 2023-03-07T15:52:39+00:00 Wibbles Tricky! - - - - - 0279d413 by Simon Peyton Jones at 2023-03-07T15:52:39+00:00 More wibbles - - - - - 30 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/expected-undocumented-flags.txt - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - libraries/base/Data/OldList.hs - libraries/base/GHC/List.hs - + m4/fp_ld_supports_response_files.m4 - testsuite/tests/deriving/should_fail/T10598_fail4.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1b10277a03196fbea62f2ca90106402c031f186c...0279d413f08d50566d942e6960e73cbd06037723 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1b10277a03196fbea62f2ca90106402c031f186c...0279d413f08d50566d942e6960e73cbd06037723 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 18:33:41 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 07 Mar 2023 13:33:41 -0500 Subject: [Git][ghc/ghc][wip/romes/no-this-unit-id-aggressive] 2 commits: Wired-in names have type WiredIn Name Message-ID: <64078385c5ae9_2c78e98fca3c024724d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/no-this-unit-id-aggressive at Glasgow Haskell Compiler / GHC Commits: b551ee50 by romes at 2023-03-07T11:57:30+00:00 Wired-in names have type WiredIn Name - - - - - 5d7a0725 by romes at 2023-03-07T18:33:31+00:00 Migrate more WiredIn types - - - - - 2 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea020879c3c261a06231fa7f60d84b5caf082835...5d7a0725af1ff8edd3ed2b82d076a14bccb13222 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea020879c3c261a06231fa7f60d84b5caf082835...5d7a0725af1ff8edd3ed2b82d076a14bccb13222 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 19:53:21 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 07 Mar 2023 14:53:21 -0500 Subject: [Git][ghc/ghc][wip/romes/no-this-unit-id-aggressive] 2 commits: Compile Builtin/Types/Prim Message-ID: <64079631eeee0_2c78e9a6d647426622b@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/no-this-unit-id-aggressive at Glasgow Haskell Compiler / GHC Commits: 8ea24a2e by romes at 2023-03-07T18:54:57+00:00 Compile Builtin/Types/Prim - - - - - 9a6aa742 by romes at 2023-03-07T19:53:10+00:00 Continue WiringIn things - - - - - 6 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - utils/genprimopcode/Main.hs Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -488,7 +488,7 @@ anyTypeOfKind kind = mkTyConApp <$> anyTyCon <*> pure [kind] -- | Make a fake, recovery 'TyCon' from an existing one. -- Used when recovering from errors in type declarations -makeRecoveryTyCon :: TyCon -> TyCon +makeRecoveryTyCon :: TyCon -> WiredIn TyCon makeRecoveryTyCon tc = mkTcTyCon (tyConName tc) bndrs res_kind @@ -548,7 +548,7 @@ pcTyCon name cType tyvars cons (VanillaAlgTyCon (mkPrelTyConRepName name)) False -- Not in GADT syntax -pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> WiredIn DataCon +pcDataCon :: WiredIn Name -> [TyVar] -> [Type] -> TyCon -> WiredIn DataCon pcDataCon n univs tys = pcDataConWithFixity False n univs [] -- no ex_tvs @@ -870,7 +870,7 @@ isBuiltInOcc_maybe occ = -- -- Test case: th/T13776 -- -isPunOcc_maybe :: Module -> OccName -> Maybe Name +isPunOcc_maybe :: Module -> OccName -> Maybe (WiredIn Name) isPunOcc_maybe mod occ | mod == gHC_TYPES, occ == occName listTyConName = Just listTyConName @@ -907,20 +907,23 @@ mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)" commas :: Arity -> String commas ar = replicate (ar-1) ',' -cTupleTyCon :: Arity -> TyCon +cTupleTyCon :: Arity -> WiredIn TyCon cTupleTyCon i - | i > mAX_CTUPLE_SIZE = fstOf3 (mk_ctuple i) -- Build one specially - | otherwise = fstOf3 (cTupleArr ! i) + | i > mAX_CTUPLE_SIZE = fstOf3 <$> (mk_ctuple i) -- Build one specially + | otherwise = fstOf3 <$> (cTupleArr ! i) -cTupleTyConName :: Arity -> Name +cTupleTyConName :: Arity -> WiredIn Name cTupleTyConName a = tyConName (cTupleTyCon a) -cTupleTyConNames :: [Name] -cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE]) +cTupleTyConNames :: WiredIn [Name] +cTupleTyConNames = sequence $ map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE]) -cTupleTyConKeys :: UniqSet Unique -cTupleTyConKeys = mkUniqSet $ map getUnique cTupleTyConNames +cTupleTyConKeys :: WiredIn (UniqSet Unique) +cTupleTyConKeys = mkUniqSet . map getUnique <$> cTupleTyConNames +-- ROMES:TODO: a lot of these functions might not need to be wired in if they +-- don't depend on the unit-id bit of the wired-in name. In which case, we can +-- simply "run the wired-in" to get a placeholder isCTupleTyConName :: Name -> Bool isCTupleTyConName n = assertPpr (isExternalName n) (ppr n) $ @@ -944,8 +947,8 @@ cTupleDataCon i cTupleDataConName :: Arity -> WiredIn Name cTupleDataConName i = dataConName (cTupleDataCon i) -cTupleDataConNames :: [Name] -cTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE]) +cTupleDataConNames :: WiredIn [Name] +cTupleDataConNames = sequence $ map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE]) cTupleSelId :: ConTag -- Superclass position -> Arity -- Arity @@ -1014,7 +1017,7 @@ unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mA -- | Cached type constructors, data constructors, and superclass selectors for -- constraint tuples. The outer array is indexed by the arity of the constraint -- tuple and the inner array is indexed by the superclass position. -cTupleArr :: Array Int (TyCon, DataCon, Array Int Id) +cTupleArr :: Array Int (WiredIn (TyCon, DataCon, Array Int Id)) cTupleArr = listArray (0,mAX_CTUPLE_SIZE) [mk_ctuple i | i <- [0..mAX_CTUPLE_SIZE]] -- Although GHC does not make use of unary constraint tuples -- (see Note [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType), @@ -1125,31 +1128,31 @@ mk_ctuple arity = (tycon, tuple_con, sc_sel_ids_arr) in sc_sel_id -unitTyCon :: TyCon +unitTyCon :: WiredIn TyCon unitTyCon = tupleTyCon Boxed 0 -unitTyConKey :: Unique -unitTyConKey = getUnique unitTyCon +unitTyConKey :: WiredIn Unique +unitTyConKey = getUnique <$> unitTyCon -unitDataCon :: DataCon -unitDataCon = head (tyConDataCons unitTyCon) +unitDataCon :: WiredIn DataCon +unitDataCon = head . tyConDataCons <$> unitTyCon -unitDataConId :: Id -unitDataConId = dataConWorkId unitDataCon +unitDataConId :: WiredIn Id +unitDataConId = dataConWorkId <$> unitDataCon -soloTyCon :: TyCon +soloTyCon :: WiredIn TyCon soloTyCon = tupleTyCon Boxed 1 -pairTyCon :: TyCon +pairTyCon :: WiredIn TyCon pairTyCon = tupleTyCon Boxed 2 -unboxedUnitTy :: Type -unboxedUnitTy = mkTyConTy unboxedUnitTyCon +unboxedUnitTy :: WiredIn Type +unboxedUnitTy = mkTyConTy <$> unboxedUnitTyCon -unboxedUnitTyCon :: TyCon +unboxedUnitTyCon :: WiredIn TyCon unboxedUnitTyCon = tupleTyCon Unboxed 0 -unboxedUnitDataCon :: DataCon +unboxedUnitDataCon :: WiredIn DataCon unboxedUnitDataCon = tupleDataCon Unboxed 0 {- ********************************************************************* @@ -1189,7 +1192,7 @@ sumTyCon arity -- | Data constructor for i-th alternative of a n-ary unboxed sum. sumDataCon :: ConTag -- Alternative -> Arity -- Arity - -> DataCon + -> WiredIn DataCon sumDataCon alt arity | alt > arity = panic ("sumDataCon: index out of bounds: alt: " @@ -1212,11 +1215,11 @@ sumDataCon alt arity -- | Cached type and data constructors for sums. The outer array is -- indexed by the arity of the sum and the inner array is indexed by -- the alternative. -unboxedSumArr :: Array Int (TyCon, Array Int DataCon) +unboxedSumArr :: Array Int (WiredIn (TyCon, Array Int DataCon)) unboxedSumArr = listArray (2,mAX_SUM_SIZE) [mk_sum i | i <- [2..mAX_SUM_SIZE]] -- | Specialization of 'unboxedTupleSumKind' for sums -unboxedSumKind :: [Type] -> Kind +unboxedSumKind :: [Type] -> WiredIn Kind unboxedSumKind = unboxedTupleSumKind sumRepDataConTyCon -- | Create type constructor and data constructors for n-ary unboxed sum. @@ -1268,10 +1271,10 @@ mk_sum arity = (tycon, sum_cons) -- necessary because the functional-dependency coverage check looks -- through superclasses, and (~#) is handled in that check. -eqTyCon, heqTyCon, coercibleTyCon :: TyCon -eqClass, heqClass, coercibleClass :: Class -eqDataCon, heqDataCon, coercibleDataCon :: DataCon -eqSCSelId, heqSCSelId, coercibleSCSelId :: Id +eqTyCon, heqTyCon, coercibleTyCon :: WiredIn TyCon +eqClass, heqClass, coercibleClass :: WiredIn Class +eqDataCon, heqDataCon, coercibleDataCon :: WiredIn DataCon +eqSCSelId, heqSCSelId, coercibleSCSelId :: WiredIn Id (eqTyCon, eqClass, eqDataCon, eqSCSelId) = (tycon, klass, datacon, sc_sel_id) @@ -1365,23 +1368,23 @@ multiplicityTyCon :: WiredIn TyCon multiplicityTyCon = pcTyCon multiplicityTyConName Nothing [] [oneDataCon, manyDataCon] -oneDataCon, manyDataCon :: DataCon +oneDataCon, manyDataCon :: WiredIn DataCon oneDataCon = pcDataCon oneDataConName [] [] multiplicityTyCon manyDataCon = pcDataCon manyDataConName [] [] multiplicityTyCon -oneDataConTy, manyDataConTy :: Type -oneDataConTy = mkTyConTy oneDataConTyCon -manyDataConTy = mkTyConTy manyDataConTyCon +oneDataConTy, manyDataConTy :: WiredIn Type +oneDataConTy = mkTyConTy <$> oneDataConTyCon +manyDataConTy = mkTyConTy <$> manyDataConTyCon -oneDataConTyCon, manyDataConTyCon :: TyCon -oneDataConTyCon = promoteDataCon oneDataCon -manyDataConTyCon = promoteDataCon manyDataCon +oneDataConTyCon, manyDataConTyCon :: WiredIn TyCon +oneDataConTyCon = promoteDataCon <$> oneDataCon +manyDataConTyCon = promoteDataCon <$> manyDataCon multMulTyConName :: WiredIn Name multMulTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "MultMul") multMulTyConKey multMulTyCon -multMulTyCon :: TyCon +multMulTyCon :: WiredIn TyCon multMulTyCon = mkFamilyTyCon multMulTyConName binders multiplicityTy Nothing (BuiltInSynFamTyCon trivialBuiltInFamily) Nothing @@ -1393,7 +1396,7 @@ multMulTyCon = mkFamilyTyCon multMulTyConName binders multiplicityTy Nothing -- type (->) :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep). -- TYPE rep1 -> TYPE rep2 -> Type -- type (->) = FUN 'Many -unrestrictedFunTyCon :: TyCon +unrestrictedFunTyCon :: WiredIn TyCon unrestrictedFunTyCon = buildSynTyCon unrestrictedFunTyConName [] arrowKind [] (TyCoRep.TyConApp fUNTyCon [manyDataConTy]) @@ -1477,7 +1480,7 @@ typeToTypeKind = liftA2 mkVisFunTyMany liftedTypeKind liftedTypeKind ---------------------- -- type UnliftedType = TYPE ('BoxedRep 'Unlifted) -unliftedTypeKindTyCon :: TyCon +unliftedTypeKindTyCon :: WiredIn TyCon unliftedTypeKindTyCon = buildSynTyCon unliftedTypeKindTyConName [] liftedTypeKind [] rhs where @@ -1487,8 +1490,8 @@ unliftedTypeKindTyConName :: WiredIn Name unliftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnliftedType") unliftedTypeKindTyConKey unliftedTypeKindTyCon -unliftedTypeKind :: Type -unliftedTypeKind = mkTyConTy unliftedTypeKindTyCon +unliftedTypeKind :: WiredIn Type +unliftedTypeKind = mkTyConTy <$> unliftedTypeKindTyCon {- ********************************************************************* @@ -1508,23 +1511,23 @@ levityTyCon = pcTyCon levityTyConName Nothing [] [liftedDataCon,unliftedDataCon] levityTy :: WiredIn Type levityTy = mkTyConTy <$> levityTyCon -liftedDataCon, unliftedDataCon :: DataCon +liftedDataCon, unliftedDataCon :: WiredIn DataCon liftedDataCon = pcSpecialDataCon liftedDataConName [] levityTyCon (Levity Lifted) unliftedDataCon = pcSpecialDataCon unliftedDataConName [] levityTyCon (Levity Unlifted) -liftedDataConTyCon :: TyCon -liftedDataConTyCon = promoteDataCon liftedDataCon +liftedDataConTyCon :: WiredIn TyCon +liftedDataConTyCon = promoteDataCon <$> liftedDataCon -unliftedDataConTyCon :: TyCon -unliftedDataConTyCon = promoteDataCon unliftedDataCon +unliftedDataConTyCon :: WiredIn TyCon +unliftedDataConTyCon = promoteDataCon <$> unliftedDataCon -liftedDataConTy :: Type -liftedDataConTy = mkTyConTy liftedDataConTyCon +liftedDataConTy :: WiredIn Type +liftedDataConTy = mkTyConTy <$> liftedDataConTyCon -unliftedDataConTy :: Type -unliftedDataConTy = mkTyConTy unliftedDataConTyCon +unliftedDataConTy :: WiredIn Type +unliftedDataConTy = mkTyConTy <$> unliftedDataConTyCon {- ********************************************************************* @@ -1572,7 +1575,7 @@ boxedRepDataConName = mk_runtime_rep_dc_name (fsLit "BoxedRep") boxedRepDataConK mk_runtime_rep_dc_name :: FastString -> Unique -> DataCon -> WiredIn Name mk_runtime_rep_dc_name fs u dc = mkWiredInDataConName UserSyntax gHC_TYPES fs u dc -boxedRepDataCon :: DataCon +boxedRepDataCon :: WiredIn DataCon boxedRepDataCon = pcSpecialDataCon boxedRepDataConName [ levityTy ] runtimeRepTyCon (RuntimeRep prim_rep_fun) where @@ -1586,10 +1589,10 @@ boxedRepDataCon = pcSpecialDataCon boxedRepDataConName = pprPanic "boxedRepDataCon" (ppr args) -boxedRepDataConTyCon :: TyCon -boxedRepDataConTyCon = promoteDataCon boxedRepDataCon +boxedRepDataConTyCon :: WiredIn TyCon +boxedRepDataConTyCon = promoteDataCon <$> boxedRepDataCon -tupleRepDataCon :: DataCon +tupleRepDataCon :: WiredIn DataCon tupleRepDataCon = pcSpecialDataCon tupleRepDataConName [ mkListTy runtimeRepTy ] runtimeRepTyCon (RuntimeRep prim_rep_fun) where @@ -1602,10 +1605,10 @@ tupleRepDataCon = pcSpecialDataCon tupleRepDataConName [ mkListTy runtimeRepTy ] prim_rep_fun args = pprPanic "tupleRepDataCon" (ppr args) -tupleRepDataConTyCon :: TyCon -tupleRepDataConTyCon = promoteDataCon tupleRepDataCon +tupleRepDataConTyCon :: WiredIn TyCon +tupleRepDataConTyCon = promoteDataCon <$> tupleRepDataCon -sumRepDataCon :: DataCon +sumRepDataCon :: WiredIn DataCon sumRepDataCon = pcSpecialDataCon sumRepDataConName [ mkListTy runtimeRepTy ] runtimeRepTyCon (RuntimeRep prim_rep_fun) where @@ -1619,12 +1622,12 @@ sumRepDataCon = pcSpecialDataCon sumRepDataConName [ mkListTy runtimeRepTy ] prim_rep_fun args = pprPanic "sumRepDataCon" (ppr args) -sumRepDataConTyCon :: TyCon -sumRepDataConTyCon = promoteDataCon sumRepDataCon +sumRepDataConTyCon :: WiredIn TyCon +sumRepDataConTyCon = promoteDataCon <$> sumRepDataCon -- See Note [Wiring in RuntimeRep] -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType -runtimeRepSimpleDataCons :: [DataCon] +runtimeRepSimpleDataCons :: WiredIn [DataCon] runtimeRepSimpleDataCons = zipWith mk_runtime_rep_dc runtimeRepSimpleDataConKeys [ (fsLit "IntRep", IntRep) @@ -1641,7 +1644,7 @@ runtimeRepSimpleDataCons , (fsLit "FloatRep", FloatRep) , (fsLit "DoubleRep", DoubleRep) ] where - mk_runtime_rep_dc :: Unique -> (FastString, PrimRep) -> DataCon + mk_runtime_rep_dc :: Unique -> (FastString, PrimRep) -> WiredIn DataCon mk_runtime_rep_dc uniq (fs, primrep) = data_con where @@ -1654,7 +1657,7 @@ intRepDataConTy, wordRepDataConTy, word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy, addrRepDataConTy, - floatRepDataConTy, doubleRepDataConTy :: RuntimeRepType + floatRepDataConTy, doubleRepDataConTy :: WiredIn RuntimeRepType [intRepDataConTy, int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy, wordRepDataConTy, @@ -1666,7 +1669,7 @@ intRepDataConTy, ---------------------- -- | @type ZeroBitRep = 'Tuple '[] -zeroBitRepTyCon :: TyCon +zeroBitRepTyCon :: WiredIn TyCon zeroBitRepTyCon = buildSynTyCon zeroBitRepTyConName [] runtimeRepTy [] rhs where @@ -1676,12 +1679,12 @@ zeroBitRepTyConName :: WiredIn Name zeroBitRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZeroBitRep") zeroBitRepTyConKey zeroBitRepTyCon -zeroBitRepTy :: RuntimeRepType -zeroBitRepTy = mkTyConTy zeroBitRepTyCon +zeroBitRepTy :: WiredIn RuntimeRepType +zeroBitRepTy = mkTyConTy <$> zeroBitRepTyCon ---------------------- -- @type ZeroBitType = TYPE ZeroBitRep -zeroBitTypeTyCon :: TyCon +zeroBitTypeTyCon :: WiredIn TyCon zeroBitTypeTyCon = buildSynTyCon zeroBitTypeTyConName [] liftedTypeKind [] rhs where @@ -1691,12 +1694,12 @@ zeroBitTypeTyConName :: WiredIn Name zeroBitTypeTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZeroBitType") zeroBitTypeTyConKey zeroBitTypeTyCon -zeroBitTypeKind :: Type -zeroBitTypeKind = mkTyConTy zeroBitTypeTyCon +zeroBitTypeKind :: WiredIn Type +zeroBitTypeKind = mkTyConTy <$> zeroBitTypeTyCon ---------------------- -- | @type LiftedRep = 'BoxedRep 'Lifted@ -liftedRepTyCon :: TyCon +liftedRepTyCon :: WiredIn TyCon liftedRepTyCon = buildSynTyCon liftedRepTyConName [] runtimeRepTy [] rhs where @@ -1706,12 +1709,12 @@ liftedRepTyConName :: WiredIn Name liftedRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "LiftedRep") liftedRepTyConKey liftedRepTyCon -liftedRepTy :: RuntimeRepType -liftedRepTy = mkTyConTy liftedRepTyCon +liftedRepTy :: WiredIn RuntimeRepType +liftedRepTy = mkTyConTy <$> liftedRepTyCon ---------------------- -- | @type UnliftedRep = 'BoxedRep 'Unlifted@ -unliftedRepTyCon :: TyCon +unliftedRepTyCon :: WiredIn TyCon unliftedRepTyCon = buildSynTyCon unliftedRepTyConName [] runtimeRepTy [] rhs where @@ -1721,8 +1724,8 @@ unliftedRepTyConName :: WiredIn Name unliftedRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnliftedRep") unliftedRepTyConKey unliftedRepTyCon -unliftedRepTy :: RuntimeRepType -unliftedRepTy = mkTyConTy unliftedRepTyCon +unliftedRepTy :: WiredIn RuntimeRepType +unliftedRepTy = mkTyConTy <$> unliftedRepTyCon {- ********************************************************************* @@ -1737,7 +1740,7 @@ vecCountTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecCount") v vecElemTyConName :: WiredIn Name vecElemTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecElem") vecElemTyConKey vecElemTyCon -vecRepDataCon :: DataCon +vecRepDataCon :: WiredIn DataCon vecRepDataCon = pcSpecialDataCon vecRepDataConName [ mkTyConTy vecCountTyCon , mkTyConTy vecElemTyCon ] runtimeRepTyCon @@ -1751,14 +1754,14 @@ vecRepDataCon = pcSpecialDataCon vecRepDataConName [ mkTyConTy vecCountTyCon prim_rep_fun args = pprPanic "vecRepDataCon" (ppr args) -vecRepDataConTyCon :: TyCon -vecRepDataConTyCon = promoteDataCon vecRepDataCon +vecRepDataConTyCon :: WiredIn TyCon +vecRepDataConTyCon = promoteDataCon <$> vecRepDataCon vecCountTyCon :: WiredIn TyCon vecCountTyCon = pcTyCon vecCountTyConName Nothing [] vecCountDataCons -- See Note [Wiring in RuntimeRep] -vecCountDataCons :: [DataCon] +vecCountDataCons :: WiredIn [DataCon] vecCountDataCons = zipWith mk_vec_count_dc [1..6] vecCountDataConKeys where mk_vec_count_dc logN key = con @@ -1769,7 +1772,7 @@ vecCountDataCons = zipWith mk_vec_count_dc [1..6] vecCountDataConKeys -- See Note [Wiring in RuntimeRep] vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy, - vec64DataConTy :: Type + vec64DataConTy :: WiredIn Type [vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy, vec64DataConTy] = map (mkTyConTy . promoteDataCon) vecCountDataCons @@ -1777,7 +1780,8 @@ vecElemTyCon :: WiredIn TyCon vecElemTyCon = pcTyCon vecElemTyConName Nothing [] vecElemDataCons -- See Note [Wiring in RuntimeRep] -vecElemDataCons :: [DataCon] +-- ROMES:TODO: Better to just get rid of the lists bc of 'WiredIn' +vecElemDataCons :: WiredIn [DataCon] vecElemDataCons = zipWith3 mk_vec_elem_dc [ fsLit "Int8ElemRep", fsLit "Int16ElemRep", fsLit "Int32ElemRep", fsLit "Int64ElemRep" , fsLit "Word8ElemRep", fsLit "Word16ElemRep", fsLit "Word32ElemRep", fsLit "Word64ElemRep" @@ -1796,7 +1800,7 @@ vecElemDataCons = zipWith3 mk_vec_elem_dc int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy, int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy, word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy, - doubleElemRepDataConTy :: Type + doubleElemRepDataConTy :: WiredIn Type [int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy, int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy, word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy, @@ -1817,13 +1821,13 @@ charTyCon = pcTyCon charTyConName (Just (CType NoSourceText Nothing (NoSourceText,fsLit "HsChar"))) [] [charDataCon] -charDataCon :: DataCon +charDataCon :: WiredIn DataCon charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon -stringTy :: Type -stringTy = mkTyConTy stringTyCon +stringTy :: WiredIn Type +stringTy = mkTyConTy <$> stringTyCon -stringTyCon :: TyCon +stringTyCon :: WiredIn TyCon -- We have this wired-in so that Haskell literal strings -- get type String (in hsLitType), which in turn influences -- inferred types and error messages @@ -1838,7 +1842,7 @@ intTyCon :: WiredIn TyCon intTyCon = pcTyCon intTyConName (Just (CType NoSourceText Nothing (NoSourceText,fsLit "HsInt"))) [] [intDataCon] -intDataCon :: DataCon +intDataCon :: WiredIn DataCon intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon wordTy :: WiredIn Type @@ -1848,7 +1852,7 @@ wordTyCon :: WiredIn TyCon wordTyCon = pcTyCon wordTyConName (Just (CType NoSourceText Nothing (NoSourceText, fsLit "HsWord"))) [] [wordDataCon] -wordDataCon :: DataCon +wordDataCon :: WiredIn DataCon wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon word8Ty :: WiredIn Type @@ -1859,7 +1863,7 @@ word8TyCon = pcTyCon word8TyConName (Just (CType NoSourceText Nothing (NoSourceText, fsLit "HsWord8"))) [] [word8DataCon] -word8DataCon :: DataCon +word8DataCon :: WiredIn DataCon word8DataCon = pcDataCon word8DataConName [] [word8PrimTy] word8TyCon floatTy :: WiredIn Type @@ -1870,8 +1874,8 @@ floatTyCon = pcTyCon floatTyConName (Just (CType NoSourceText Nothing (NoSourceText, fsLit "HsFloat"))) [] [floatDataCon] -floatDataCon :: DataCon -floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon +floatDataCon :: WiredIn DataCon +floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon doubleTy :: WiredIn Type doubleTy = mkTyConTy <$> doubleTyCon @@ -1882,7 +1886,7 @@ doubleTyCon = pcTyCon doubleTyConName (NoSourceText,fsLit "HsDouble"))) [] [doubleDataCon] -doubleDataCon :: DataCon +doubleDataCon :: WiredIn DataCon doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon {- ********************************************************************* ===================================== compiler/GHC/Builtin/Types.hs-boot ===================================== @@ -67,7 +67,7 @@ multMulTyCon :: TyCon tupleTyConName :: TupleSort -> Arity -> Name tupleDataConName :: Boxity -> Arity -> Name -integerTy, naturalTy :: Type +integerTy, naturalTy :: WiredIn Type promotedTupleDataCon :: Boxity -> Arity -> WiredIn TyCon ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -462,40 +462,53 @@ mkTemplateAnonTyConBindersFrom n kinds alphaTyVars :: WiredIn [TyVar] alphaTyVars = mkTemplateTyVars <$> sequence (repeat liftedTypeKind) -alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar :: TyVar -(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars - -alphaTyVarSpec, betaTyVarSpec, gammaTyVarSpec, deltaTyVarSpec :: TyVarBinder -(alphaTyVarSpec:betaTyVarSpec:gammaTyVarSpec:deltaTyVarSpec:_) = mkTyVarBinders Specified alphaTyVars - -alphaConstraintTyVars :: [TyVar] -alphaConstraintTyVars = mkTemplateTyVars $ repeat constraintKind - -alphaConstraintTyVar :: TyVar -(alphaConstraintTyVar:_) = alphaConstraintTyVars - -alphaConstraintTy :: Type -alphaConstraintTy = mkTyVarTy alphaConstraintTyVar - -alphaTys :: [Type] -alphaTys = mkTyVarTys alphaTyVars -alphaTy, betaTy, gammaTy, deltaTy :: Type -(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys - -alphaTyVarsUnliftedRep :: [TyVar] -alphaTyVarsUnliftedRep = mkTemplateTyVars $ repeat unliftedTypeKind - -alphaTyVarUnliftedRep :: TyVar -(alphaTyVarUnliftedRep:_) = alphaTyVarsUnliftedRep - -alphaTysUnliftedRep :: [Type] -alphaTysUnliftedRep = mkTyVarTys alphaTyVarsUnliftedRep -alphaTyUnliftedRep :: Type -(alphaTyUnliftedRep:_) = alphaTysUnliftedRep +alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar :: WiredIn TyVar +alphaTyVar = (\case (alphaTyVar:_betaTyVar:_gammaTyVar:_deltaTyVar:_) -> alphaTyVar) <$> alphaTyVars +betaTyVar = (\case (_alphaTyVar:betaTyVar:_gammaTyVar:_deltaTyVar:_) -> betaTyVar) <$> alphaTyVars +gammaTyVar = (\case (_alphaTyVar:_betaTyVar:gammaTyVar:_deltaTyVar:_) -> gammaTyVar) <$> alphaTyVars +deltaTyVar = (\case (_alphaTyVar:_betaTyVar:_gammaTyVar:deltaTyVar:_) -> deltaTyVar) <$> alphaTyVars + +alphaTyVarSpec, betaTyVarSpec, gammaTyVarSpec, deltaTyVarSpec :: WiredIn TyVarBinder +alphaTyVarSpec = (\case (alphaTyVarSpec:_betaTyVarSpec:_gammaTyVarSpec:_deltaTyVarSpec:_) -> alphaTyVarSpec) . mkTyVarBinders Specified <$> alphaTyVars +betaTyVarSpec = (\case (_alphaTyVarSpec:betaTyVarSpec:_gammaTyVarSpec:_deltaTyVarSpec:_) -> betaTyVarSpec) . mkTyVarBinders Specified <$> alphaTyVars +gammaTyVarSpec = (\case (_alphaTyVarSpec:_betaTyVarSpec:gammaTyVarSpec:_deltaTyVarSpec:_) -> gammaTyVarSpec) . mkTyVarBinders Specified <$> alphaTyVars +deltaTyVarSpec = (\case (_alphaTyVarSpec:_betaTyVarSpec:_gammaTyVarSpec:deltaTyVarSpec:_) -> deltaTyVarSpec) . mkTyVarBinders Specified <$> alphaTyVars + +alphaConstraintTyVars :: WiredIn [TyVar] +alphaConstraintTyVars = mkTemplateTyVars <$> sequence (repeat constraintKind) + +alphaConstraintTyVar :: WiredIn TyVar +alphaConstraintTyVar = (\case (alphaConstraintTyVar:_) -> alphaConstraintTyVar) <$> alphaConstraintTyVars + +alphaConstraintTy :: WiredIn Type +alphaConstraintTy = mkTyVarTy <$> alphaConstraintTyVar + +alphaTys :: WiredIn [Type] +alphaTys = mkTyVarTys <$> alphaTyVars +alphaTy, betaTy, gammaTy, deltaTy :: WiredIn Type +alphaTy = (\case (alphaTy:_betaTy:_gammaTy:_deltaTy:_) -> alphaTy) <$> alphaTys +betaTy = (\case (_alphaTy:betaTy:_gammaTy:_deltaTy:_) -> betaTy) <$> alphaTys +gammaTy = (\case (_alphaTy:_betaTy:gammaTy:_deltaTy:_) -> gammaTy) <$> alphaTys +deltaTy = (\case (_alphaTy:_betaTy:_gammaTy:deltaTy:_) -> deltaTy) <$> alphaTys + +alphaTyVarsUnliftedRep :: WiredIn [TyVar] +alphaTyVarsUnliftedRep = mkTemplateTyVars <$> sequence (repeat unliftedTypeKind) + +alphaTyVarUnliftedRep :: WiredIn TyVar +alphaTyVarUnliftedRep = (\case (alphaTyVarUnliftedRep:_) -> alphaTyVarUnliftedRep) <$> alphaTyVarsUnliftedRep + +alphaTysUnliftedRep :: WiredIn [Type] +alphaTysUnliftedRep = mkTyVarTys <$> alphaTyVarsUnliftedRep +alphaTyUnliftedRep :: WiredIn Type +alphaTyUnliftedRep = (\case (alphaTyUnliftedRep:_) -> alphaTyUnliftedRep) <$> alphaTysUnliftedRep runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar :: WiredIn TyVar -(runtimeRep1TyVar : runtimeRep2TyVar : runtimeRep3TyVar : _) - = drop 16 . mkTemplateTyVars <$> sequence (repeat runtimeRepTy) -- selects 'q','r' +runtimeRep1TyVar = (\case (runtimeRep1TyVar : _runtimeRep2TyVar : _runtimeRep3TyVar : _) -> runtimeRep1TyVar) <$> runtimeRepTyVars +runtimeRep2TyVar = (\case (_runtimeRep1TyVar : runtimeRep2TyVar : _runtimeRep3TyVar : _) -> runtimeRep2TyVar) <$> runtimeRepTyVars +runtimeRep3TyVar = (\case (_runtimeRep1TyVar : _runtimeRep2TyVar : runtimeRep3TyVar : _) -> runtimeRep3TyVar) <$> runtimeRepTyVars + +runtimeRepTyVars :: WiredIn [TyVar] +runtimeRepTyVars = drop 16 . mkTemplateTyVars <$> sequence (repeat runtimeRepTy) -- selects 'q','r' runtimeRep1TyVarInf, runtimeRep2TyVarInf :: WiredIn TyVarBinder runtimeRep1TyVarInf = mkTyVarBinder Inferred <$> runtimeRep1TyVar @@ -528,9 +541,12 @@ openAlphaTy = mkTyVarTy <$> openAlphaTyVar openBetaTy = mkTyVarTy <$> openBetaTyVar openGammaTy = mkTyVarTy <$> openGammaTyVar +levityTyVars :: WiredIn [TyVar] +levityTyVars = drop 10 . mkTemplateTyVars <$> sequence (repeat levityTy) -- selects 'k', 'l' levity1TyVar, levity2TyVar :: WiredIn TyVar -(levity2TyVar : levity1TyVar : _) -- NB: levity2TyVar before levity1TyVar - = drop 10 . mkTemplateTyVars <$> sequence (repeat levityTy) -- selects 'k', 'l' +-- NB: levity2TyVar before levity1TyVar +levity2TyVar = (\case (levity2TyVar : _levity1TyVar : _) -> levity2TyVar) <$> levityTyVars +levity1TyVar = (\case (_levity2TyVar : levity1TyVar : _) -> levity1TyVar) <$> levityTyVars -- The ordering of levity2TyVar before levity1TyVar is chosen so that -- the more common levity1TyVar uses the levity variable 'l'. @@ -561,9 +577,12 @@ levPolyAlphaTy, levPolyBetaTy :: WiredIn Type levPolyAlphaTy = mkTyVarTy <$> levPolyAlphaTyVar levPolyBetaTy = mkTyVarTy <$> levPolyBetaTyVar -multiplicityTyVar1, multiplicityTyVar2 :: WiredIn TyVar -(multiplicityTyVar1 : multiplicityTyVar2 : _) +multiplicityTyVars :: WiredIn [TyVar] +multiplicityTyVars = drop 13 . mkTemplateTyVars <$> sequence (repeat multiplicityTy) -- selects 'n', 'm' +multiplicityTyVar1, multiplicityTyVar2 :: WiredIn TyVar +multiplicityTyVar1 = (\case (multiplicityTyVar1 : _multiplicityTyVar2 : _) -> multiplicityTyVar1) <$> multiplicityTyVars +multiplicityTyVar2 = (\case (_multiplicityTyVar1 : multiplicityTyVar2 : _) -> multiplicityTyVar2) <$> multiplicityTyVars {- ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -1794,11 +1794,15 @@ mkAlgTyCon name binders res_kind roles cType stupid rhs parent gadt_syn , algTcGadtSyntax = gadt_syn } -- | Simpler specialization of 'mkAlgTyCon' for classes +-- ROMES:TODO: Comment Core with "Why WiredIn". +-- Even consider moving out of Core? +-- Classes are wired in mkClassTyCon :: Name -> [TyConBinder] -> [Role] -> AlgTyConRhs -> Class - -> Name -> TyCon + -> Name -> WiredIn TyCon mkClassTyCon name binders roles rhs clas tc_rep_name - = mkAlgTyCon name binders constraintKind roles Nothing [] rhs + = constraintKind >>= \wiredConstraintKind -> pure $ + mkAlgTyCon name binders wiredConstraintKind roles Nothing [] rhs (ClassTyCon clas tc_rep_name) False @@ -1873,13 +1877,14 @@ mkPrimTyCon :: WiredIn Name -- change tcHasFixedRuntimeRep, marshalablePrimTyCon, reifyTyCon for PrimTyCons.) -> [Role] -> WiredIn TyCon -mkPrimTyCon name' binders res_kind' roles - = name' >>= \name -> - res_kind' >>= \res_kind -> - mkPrelTyConRepName name >>= \prelTyConRepName -> - pure $ - mkTyCon name binders res_kind roles $ - PrimTyCon { primRepName = prelTyConRepName } +mkPrimTyCon name' binders' res_kind' roles + = do name <- name' + binders <- binders' + res_kind <- res_kind' + prelTyConRepName <- mkPrelTyConRepName name + pure $ + mkTyCon name binders res_kind roles $ + PrimTyCon { primRepName = prelTyConRepName } -- | Create a type synonym 'TyCon' mkSynonymTyCon :: Name -> [TyConBinder] -> Kind -- ^ /result/ kind @@ -2278,17 +2283,20 @@ isDataKindsPromotedDataCon (TyCon { tyConDetails = details }) -- | Is this tycon really meant for use at the kind level? That is, -- should it be permitted without -XDataKinds? -isKindTyCon :: TyCon -> Bool -isKindTyCon tc = getUnique tc `elementOfUniqSet` kindTyConKeys +isKindTyCon :: TyCon -> WiredIn Bool +isKindTyCon tc = (getUnique tc `elementOfUniqSet`) <$> kindTyConKeys -- | These TyCons should be allowed at the kind level, even without -- -XDataKinds. -kindTyConKeys :: UniqSet Unique -kindTyConKeys = unionManyUniqSets - ( mkUniqSet [ liftedTypeKindTyConKey, liftedRepTyConKey, constraintKindTyConKey, tYPETyConKey ] - : map (mkUniqSet . tycon_with_datacons) [ runtimeRepTyCon, levityTyCon - , multiplicityTyCon - , vecCountTyCon, vecElemTyCon ] ) +-- ROMES:TODO: WiredIn UniqSet of WiredIn things +kindTyConKeys :: WiredIn (UniqSet Unique) +kindTyConKeys = do + tyCons <- sequence [ runtimeRepTyCon, levityTyCon + , multiplicityTyCon + , vecCountTyCon, vecElemTyCon ] + pure $ unionManyUniqSets + ( mkUniqSet [ liftedTypeKindTyConKey, liftedRepTyConKey, constraintKindTyConKey, tYPETyConKey ] + : map (mkUniqSet . tycon_with_datacons) tyCons ) where tycon_with_datacons tc = getUnique tc : map getUnique (tyConDataCons tc) ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -3245,13 +3245,13 @@ coreView applied to (TyConApp LiftedRep []) -} -mkTYPEapp :: RuntimeRepType -> Type +mkTYPEapp :: RuntimeRepType -> WiredIn Type mkTYPEapp rr = case mkTYPEapp_maybe rr of Just ty -> ty Nothing -> TyConApp tYPETyCon [rr] -mkTYPEapp_maybe :: RuntimeRepType -> Maybe Type +mkTYPEapp_maybe :: RuntimeRepType -> Maybe (WiredIn Type) -- ^ Given a @RuntimeRep@, applies @TYPE@ to it. -- On the fly it rewrites -- TYPE LiftedRep --> liftedTypeKind (a synonym) @@ -3273,14 +3273,14 @@ mkTYPEapp_maybe (TyConApp tc args) mkTYPEapp_maybe _ = Nothing ------------------ -mkCONSTRAINTapp :: RuntimeRepType -> Type +mkCONSTRAINTapp :: RuntimeRepType -> WiredIn Type -- ^ Just like mkTYPEapp mkCONSTRAINTapp rr = case mkCONSTRAINTapp_maybe rr of Just ty -> ty Nothing -> TyConApp cONSTRAINTTyCon [rr] -mkCONSTRAINTapp_maybe :: RuntimeRepType -> Maybe Type +mkCONSTRAINTapp_maybe :: RuntimeRepType -> Maybe (WiredIn Type) -- ^ Just like mkTYPEapp_maybe {-# NOINLINE mkCONSTRAINTapp_maybe #-} mkCONSTRAINTapp_maybe (TyConApp tc args) @@ -3289,7 +3289,7 @@ mkCONSTRAINTapp_maybe (TyConApp tc args) mkCONSTRAINTapp_maybe _ = Nothing ------------------ -mkBoxedRepApp_maybe :: LevityType -> Maybe Type +mkBoxedRepApp_maybe :: LevityType -> Maybe (WiredIn Type) -- ^ Given a `Levity`, apply `BoxedRep` to it -- On the fly, rewrite -- BoxedRep Lifted --> liftedRepTy (a synonym) @@ -3317,6 +3317,6 @@ mkTupleRepApp_maybe (TyConApp tc args) key = tyConUnique tc mkTupleRepApp_maybe _ = Nothing -typeOrConstraintKind :: TypeOrConstraint -> RuntimeRepType -> Kind +typeOrConstraintKind :: TypeOrConstraint -> RuntimeRepType -> WiredIn Kind typeOrConstraintKind TypeLike rep = mkTYPEapp rep typeOrConstraintKind ConstraintLike rep = mkCONSTRAINTapp rep ===================================== utils/genprimopcode/Main.hs ===================================== @@ -537,8 +537,8 @@ gen_primop_vector_tys (Info _ entries) , ty_id ++ " :: WiredIn Type" , ty_id ++ " = mkTyConTy <$> " ++ tycon_id , tycon_id ++ " :: WiredIn TyCon" - , tycon_id ++ " = flip pcPrimTyCon0 " ++ - " (TyConApp vecRepDataConTyCon [vec" ++ show (veclen i) ++ "DataConTy, " ++ elemrep i ++ "]) =<< " ++ name_id + , tycon_id ++ " = pcPrimTyCon0 " ++ name_id ++ + " (TyConApp <$> vecRepDataConTyCon <*> sequence [vec" ++ show (veclen i) ++ "DataConTy, " ++ elemrep i ++ "])" ] where key_id = prefix i ++ "PrimTyConKey" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d7a0725af1ff8edd3ed2b82d076a14bccb13222...9a6aa7422e3685652a3643c96bec255b7b19ba24 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d7a0725af1ff8edd3ed2b82d076a14bccb13222...9a6aa7422e3685652a3643c96bec255b7b19ba24 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 21:09:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Mar 2023 16:09:06 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T23088 Message-ID: <6407a7f2c672a_2c78e9b9a7f1c28064e@gitlab.mail> Ben Gamari pushed new branch wip/T23088 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23088 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 21:57:20 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Tue, 07 Mar 2023 16:57:20 -0500 Subject: [Git][ghc/ghc][wip/t21766] 40 commits: Don't suppress *all* Wanteds Message-ID: <6407b340d26a1_2c78e9ca1e9902928ee@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - 48be175a by Finley McIlwaine at 2023-03-07T14:57:01-07:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - e903e8f5 by Finley McIlwaine at 2023-03-07T14:57:01-07:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - 2d058dff by Finley McIlwaine at 2023-03-07T14:57:01-07:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 35dfbbe2 by Finley McIlwaine at 2023-03-07T14:57:01-07:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 84c32197 by Finley McIlwaine at 2023-03-07T14:57:01-07:00 Add note describing IPE data compression See ticket #21766 - - - - - afa5777c by Finley McIlwaine at 2023-03-07T14:57:01-07:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 17be53f7 by Finley McIlwaine at 2023-03-07T14:57:02-07:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a53d5427 by Finley McIlwaine at 2023-03-07T14:57:02-07:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 84de1e3a by Finley McIlwaine at 2023-03-07T14:57:02-07:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 7149e66c by Finley McIlwaine at 2023-03-07T14:57:02-07:00 Update user's guide and release notes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. See ticket #21766 - - - - - 6e5da6c7 by Finley McIlwaine at 2023-03-07T14:57:02-07:00 Fix multiline string in `IPE.c` - - - - - 0d45b252 by Finley McIlwaine at 2023-03-07T14:57:02-07:00 Optional static linking of libzstd Allow for libzstd to be statically linked with a `--enable-static-libzstd` configure flag. Not supported on darwin due to incompatibility with `:x.a` linker flags. - - - - - 0232df2f by Finley McIlwaine at 2023-03-07T14:57:02-07:00 Detect darwin for `--enable-static-libzstd` Update users guide to note the optional static linking of libzstd, and update ci-images rev to get libzstd in debian images on CI - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Types/Error/Codes.hs - compiler/ghc.cabal.in - configure.ac The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67a13bd2102fe79c849e713707bc62c84c73288f...0232df2f562260fa1b025fa1df91b03f5cc1bd40 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67a13bd2102fe79c849e713707bc62c84c73288f...0232df2f562260fa1b025fa1df91b03f5cc1bd40 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 22:09:36 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Mar 2023 17:09:36 -0500 Subject: [Git][ghc/ghc][wip/T22264] 129 commits: Add -single-threaded flag to force single threaded rts Message-ID: <6407b620eb1e2_2c78e9cafd564294397@gitlab.mail> Ben Gamari pushed to branch wip/T22264 at Glasgow Haskell Compiler / GHC Commits: 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - 53ceebeb by Ben Gamari at 2023-03-07T17:08:39-05:00 nonmoving: Fix style - - - - - 1bcb3545 by Ben Gamari at 2023-03-07T17:08:39-05:00 nonmoving: Deduplicate assertion - - - - - 65715f23 by Ben Gamari at 2023-03-07T17:08:39-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - b1e43c73 by Ben Gamari at 2023-03-07T17:08:40-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 541a7bba by Ben Gamari at 2023-03-07T17:08:40-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - c96391ec by Ben Gamari at 2023-03-07T17:08:40-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 0bf5f73e by Ben Gamari at 2023-03-07T17:08:40-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 748e7f8d by Ben Gamari at 2023-03-07T17:08:40-05:00 Evac: Squash data race in eval_selector_chain - - - - - ffcc86da by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 7b8aee9b by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Clarify comment - - - - - da90635e by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - 34d25b90 by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 25ec7acb by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - 2c8a4899 by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - a612f98a by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 2805cc5e by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 640cde1a by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 7d085a7f by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Assert state of swept segments - - - - - b9ac96c5 by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - af868d33 by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - eaeaba5b by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - 3014152d by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Post-sweep sanity checking - - - - - d6a21060 by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Avoid n_caps race - - - - - 2c81e3e1 by Ben Gamari at 2023-03-07T17:08:40-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - eaf65762 by Ben Gamari at 2023-03-07T17:08:41-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - de348259 by Ben Gamari at 2023-03-07T17:08:41-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - 764f7a01 by Ben Gamari at 2023-03-07T17:08:41-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - f3d4de43 by Ben Gamari at 2023-03-07T17:08:41-05:00 rts: Reenable assertion - - - - - f151ce95 by Ben Gamari at 2023-03-07T17:09:29-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - ef0d4a06 by Ben Gamari at 2023-03-07T17:09:29-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 5db881ce by Ben Gamari at 2023-03-07T17:09:29-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - d7987666 by Ben Gamari at 2023-03-07T17:09:29-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 80d09f61 by Ben Gamari at 2023-03-07T17:09:29-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - b4b4165f by Ben Gamari at 2023-03-07T17:09:29-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 019c4c02 by Ben Gamari at 2023-03-07T17:09:29-05:00 nonmoving: Fix unregisterised build - - - - - 32a67841 by Ben Gamari at 2023-03-07T17:09:29-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - 8b13603a by Ben Gamari at 2023-03-07T17:09:29-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 39fe7a67 by Ben Gamari at 2023-03-07T17:09:29-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 04ba7d52 by Ben Gamari at 2023-03-07T17:09:30-05:00 nonmoving: Move allocator into new source file - - - - - 4a461ef3 by Ben Gamari at 2023-03-07T17:09:30-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 637a2b5e by Ben Gamari at 2023-03-07T17:09:30-05:00 rts: Acquire alloc spinlock when not in use - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/test-metrics.sh - CODEOWNERS - cabal.project-reinstall - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/RoughMap.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/83c53be54d7019b57891d1475996d4dc2c343274...637a2b5e8d768c4db99ad1fb0f40290da093ea20 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/83c53be54d7019b57891d1475996d4dc2c343274...637a2b5e8d768c4db99ad1fb0f40290da093ea20 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 7 23:31:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Mar 2023 18:31:39 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Documentation: describe laziness of several function from Data.List Message-ID: <6407c95b1bea6_2c78e9e0bcd5029609f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - a8c6d55b by MorrowM at 2023-03-07T18:31:32-05:00 Fix documentation for traceWith and friends - - - - - 5 changed files: - libraries/base/Data/Functor.hs - libraries/base/Data/OldList.hs - libraries/base/Debug/Trace.hs - libraries/base/GHC/List.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/Data/Functor.hs ===================================== @@ -43,10 +43,12 @@ module Data.Functor ($>), (<$>), (<&>), + unzip, void, ) where import GHC.Base ( Functor(..), flip ) +import Data.Tuple ( fst, snd ) -- $setup -- Allow the use of Prelude in doctests. @@ -159,6 +161,9 @@ infixl 4 $> ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$) +unzip :: Functor f => f (a,b) -> (f a, f b) +unzip xs = (fst <$> xs, snd <$> xs) + -- | @'void' value@ discards or ignores the result of evaluation, such -- as the return value of an 'System.IO.IO' action. -- ===================================== libraries/base/Data/OldList.hs ===================================== @@ -233,12 +233,26 @@ infix 5 \\ -- comment to fool cpp: https://downloads.haskell.org/~ghc/latest/doc -- -- >>> dropWhileEnd isSpace "foo\n" -- "foo" --- -- >>> dropWhileEnd isSpace "foo bar" -- "foo bar" --- -- > dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined -- +-- This function is lazy in spine, but strict in elements, +-- which makes it different from 'reverse' '.' 'dropWhile' @p@ '.' 'reverse', +-- which is strict in spine, but lazy in elements. For instance: +-- +-- >>> take 1 (dropWhileEnd (< 0) (1 : undefined)) +-- [1] +-- >>> take 1 (reverse $ dropWhile (< 0) $ reverse (1 : undefined)) +-- *** Exception: Prelude.undefined +-- +-- but on the other hand +-- +-- >>> last (dropWhileEnd (< 0) [undefined, 1]) +-- *** Exception: Prelude.undefined +-- >>> last (reverse $ dropWhile (< 0) $ reverse [undefined, 1]) +-- 1 +-- -- @since 4.5.0.0 dropWhileEnd :: (a -> Bool) -> [a] -> [a] dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] @@ -344,6 +358,11 @@ findIndices p ls = build $ \c n -> -- >>> [0..] `isPrefixOf` [0..] -- * Hangs forever * -- +-- 'isPrefixOf' shortcuts when the first argument is empty: +-- +-- >>> isPrefixOf [] undefined +-- True +-- isPrefixOf :: (Eq a) => [a] -> [a] -> Bool isPrefixOf [] _ = True isPrefixOf _ [] = False @@ -600,6 +619,14 @@ intersectBy eq xs ys = [x | x <- xs, any (eq x) ys] -- -- >>> intersperse ',' "abcde" -- "a,b,c,d,e" +-- +-- 'intersperse' has the following laziness properties: +-- +-- >>> take 1 (intersperse undefined ('a' : undefined)) +-- "a" +-- >>> take 2 (intersperse ',' ('a' : undefined)) +-- "a*** Exception: Prelude.undefined +-- intersperse :: a -> [a] -> [a] intersperse _ [] = [] intersperse sep (x:xs) = x : prependToAll sep xs @@ -619,6 +646,14 @@ prependToAll sep (x:xs) = sep : x : prependToAll sep xs -- -- >>> intercalate ", " ["Lorem", "ipsum", "dolor"] -- "Lorem, ipsum, dolor" +-- +-- 'intercalate' has the following laziness properties: +-- +-- >>> take 5 (intercalate undefined ("Lorem" : undefined)) +-- "Lorem" +-- >>> take 6 (intercalate ", " ("Lorem" : undefined)) +-- "Lorem*** Exception: Prelude.undefined +-- intercalate :: [a] -> [[a]] -> [a] intercalate xs xss = concat (intersperse xs xss) @@ -638,6 +673,11 @@ intercalate xs xss = concat (intersperse xs xss) -- >>> transpose (repeat []) -- * Hangs forever * -- +-- 'transpose' is lazy: +-- +-- >>> take 1 (transpose ['a' : undefined, 'b' : undefined]) +-- ["ab"] +-- transpose :: [[a]] -> [[a]] transpose [] = [] transpose ([] : xss) = transpose xss @@ -708,6 +748,12 @@ select p x ~(ts,fs) | p x = (x:ts,fs) -- 'foldl'; it applies a function to each element of a list, passing -- an accumulating parameter from left to right, and returning a final -- value of this accumulator together with the new list. +-- +-- 'mapAccumL' does not force accumulator if it is unused: +-- +-- >>> take 1 (snd (mapAccumL (\_ x -> (undefined, x)) undefined ('a' : undefined))) +-- "a" +-- mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list -- and accumulator, returning new -- accumulator and elt of result list @@ -1234,6 +1280,13 @@ tails lst = build (\c n -> -- >>> take 8 $ subsequences ['a'..] -- ["","a","b","ab","c","ac","bc","abc"] -- +-- 'subsequences' does not look ahead unless it must: +-- +-- >>> take 1 (subsequences undefined) +-- [[]] +-- >>> take 2 (subsequences ('a' : undefined)) +-- ["","a"] +-- subsequences :: [a] -> [[a]] subsequences xs = [] : nonEmptySubsequences xs @@ -1550,6 +1603,11 @@ singleton x = [x] -- >>> unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10 -- [10,9,8,7,6,5,4,3,2,1] -- +-- Laziness: +-- +-- >>> take 1 (unfoldr (\x -> Just (x, undefined)) 'a') +-- "a" +-- -- Note [INLINE unfoldr] -- ~~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/Debug/Trace.hs ===================================== @@ -173,7 +173,7 @@ Like 'trace', but outputs the result of calling a function on the argument. hello ("hello","world") - at since 4.17.0.0 + at since 4.18.0.0 -} traceWith :: (a -> String) -> a -> a traceWith f a = trace (f a) a @@ -186,7 +186,7 @@ a 'String'. 3 [1,2,3] - at since 4.17.0.0 + at since 4.18.0.0 -} traceShowWith :: Show b => (a -> b) -> a -> a traceShowWith f = traceWith (show . f) @@ -303,7 +303,7 @@ traceEventIO msg = -- | Like 'traceEvent', but emits the result of calling a function on its -- argument. -- --- @since 4.17.0.0 +-- @since 4.18.0.0 traceEventWith :: (a -> String) -> a -> a traceEventWith f a = traceEvent (f a) a ===================================== libraries/base/GHC/List.hs ===================================== @@ -449,8 +449,10 @@ product = foldl' (*) 1 -- [100,99,97,94,90] -- >>> scanl (\reversedString nextChar -> nextChar : reversedString) "foo" ['a', 'b', 'c', 'd'] -- ["foo","afoo","bafoo","cbafoo","dcbafoo"] --- >>> scanl (+) 0 [1..] --- * Hangs forever * +-- >>> take 10 (scanl (+) 0 [1..]) +-- [0,1,3,6,10,15,21,28,36,45] +-- >>> take 1 (scanl undefined 'a' undefined) +-- "a" -- This peculiar arrangement is necessary to prevent scanl being rewritten in -- its own right-hand side. @@ -496,8 +498,10 @@ constScanl = const -- [True,False,False,False] -- >>> scanl1 (||) [False, False, True, True] -- [False,False,True,True] --- >>> scanl1 (+) [1..] --- * Hangs forever * +-- >>> take 10 (scanl1 (+) [1..]) +-- [1,3,6,10,15,21,28,36,45,55] +-- >>> take 1 (scanl1 undefined ('a' : undefined)) +-- "a" scanl1 :: (a -> a -> a) -> [a] -> [a] scanl1 f (x:xs) = scanl f x xs scanl1 _ [] = [] @@ -753,9 +757,12 @@ minimum xs = foldl1' min xs -- variant of this function. -- -- >>> take 10 $ iterate not True --- [True,False,True,False... +-- [True,False,True,False,True,False,True,False,True,False] -- >>> take 10 $ iterate (+3) 42 --- [42,45,48,51,54,57,60,63... +-- [42,45,48,51,54,57,60,63,66,69] +-- >>> take 1 $ iterate undefined 42 +-- [42] +-- {-# NOINLINE [1] iterate #-} iterate :: (a -> a) -> a -> [a] iterate f x = x : iterate f (f x) @@ -776,6 +783,10 @@ iterateFB c f x0 = go x0 -- It forces the result of each application of the function to weak head normal -- form (WHNF) -- before proceeding. +-- +-- >>> take 1 $ iterate' undefined 42 +-- *** Exception: Prelude.undefined +-- {-# NOINLINE [1] iterate' #-} iterate' :: (a -> a) -> a -> [a] iterate' f x = @@ -835,10 +846,13 @@ replicate n x = take n (repeat x) -- -- >>> cycle [] -- *** Exception: Prelude.cycle: empty list --- >>> cycle [42] --- [42,42,42,42,42,42,42,42,42,42... --- >>> cycle [2, 5, 7] --- [2,5,7,2,5,7,2,5,7,2,5,7... +-- >>> take 10 (cycle [42]) +-- [42,42,42,42,42,42,42,42,42,42] +-- >>> take 10 (cycle [2, 5, 7]) +-- [2,5,7,2,5,7,2,5,7,2] +-- >>> take 1 (cycle (42 : undefined)) +-- [42] +-- cycle :: HasCallStack => [a] -> [a] cycle [] = errorEmptyList "cycle" cycle xs = xs' where xs' = xs ++ xs' @@ -852,6 +866,16 @@ cycle xs = xs' where xs' = xs ++ xs' -- [1,2,3] -- >>> takeWhile (< 0) [1,2,3] -- [] +-- +-- Laziness: +-- +-- >>> takeWhile (const False) undefined +-- *** Exception: Prelude.undefined +-- >>> takeWhile (const False) (undefined : undefined) +-- [] +-- >>> take 1 (takeWhile (const True) (1 : undefined)) +-- [1] +-- {-# NOINLINE [1] takeWhile #-} takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile _ [] = [] @@ -908,6 +932,13 @@ dropWhile p xs@(x:xs') -- >>> take 0 [1,2] -- [] -- +-- Laziness: +-- +-- >>> take 0 undefined +-- [] +-- >>> take 1 (1 : undefined) +-- [1] +-- -- It is an instance of the more general 'Data.List.genericTake', -- in which @n@ may be of any integral type. take :: Int -> [a] -> [a] @@ -1018,8 +1049,17 @@ drop n ls -- >>> splitAt (-1) [1,2,3] -- ([],[1,2,3]) -- --- It is equivalent to @('take' n xs, 'drop' n xs)@ when @n@ is not @_|_@ --- (@splitAt _|_ xs = _|_@). +-- It is equivalent to @('take' n xs, 'drop' n xs)@ +-- unless @n@ is @_|_@: +-- @splitAt _|_ xs = _|_@, not @(_|_, _|_)@). +-- +-- The first component of the tuple is produced lazily: +-- +-- >>> fst (splitAt 0 undefined) +-- [] +-- >>> take 1 (fst (splitAt 10 (1 : undefined))) +-- [1] +-- -- 'splitAt' is an instance of the more general 'Data.List.genericSplitAt', -- in which @n@ may be of any integral type. splitAt :: Int -> [a] -> ([a],[a]) @@ -1050,7 +1090,24 @@ splitAt n ls -- >>> span (< 0) [1,2,3] -- ([],[1,2,3]) -- --- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ +-- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@, even if @p@ is @_|_ at . +-- +-- Laziness: +-- +-- >>> span undefined [] +-- ([],[]) +-- >>> fst (span (const False) undefined) +-- *** Exception: Prelude.undefined +-- >>> fst (span (const False) (undefined : undefined)) +-- [] +-- >>> take 1 (fst (span (const True) (1 : undefined))) +-- [1] +-- +-- 'span' produces the first component of the tuple lazily: +-- +-- >>> take 10 (fst (span (const True) [1..])) +-- [1,2,3,4,5,6,7,8,9,10] +-- span :: (a -> Bool) -> [a] -> ([a],[a]) span _ xs@[] = (xs, xs) span p xs@(x:xs') @@ -1068,7 +1125,26 @@ span p xs@(x:xs') -- >>> break (> 9) [1,2,3] -- ([1,2,3],[]) -- --- 'break' @p@ is equivalent to @'span' ('not' . p)@. +-- 'break' @p@ is equivalent to @'span' ('not' . p)@ +-- and consequently to @('takeWhile' ('not' . p) xs, 'dropWhile' ('not' . p) xs)@, +-- even if @p@ is @_|_ at . +-- +-- Laziness: +-- +-- >>> break undefined [] +-- ([],[]) +-- >>> fst (break (const True) undefined) +-- *** Exception: Prelude.undefined +-- >>> fst (break (const True) (undefined : undefined)) +-- [] +-- >>> take 1 (fst (break (const False) (1 : undefined))) +-- [1] +-- +-- 'break' produces the first component of the tuple lazily: +-- +-- >>> take 10 (fst (break (const False) [1..])) +-- [1,2,3,4,5,6,7,8,9,10] +-- break :: (a -> Bool) -> [a] -> ([a],[a]) #if defined(USE_REPORT_PRELUDE) break p = span (not . p) ===================================== libraries/base/changelog.md ===================================== @@ -11,6 +11,7 @@ ([CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113)) * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) + * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) ## 4.18.0.0 *TBA* @@ -82,6 +83,9 @@ * `InfoProv` now has additional `ipSrcFile` and `ipSrcSpan` fields. `ipLoc` is now a function computed from these fields. * The `whereFrom` function has been moved + * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to + `Debug.Trace`, per + [CLC proposal #36](https://github.com/haskell/core-libraries-committee/issues/36). ## 4.17.0.0 *August 2022* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc3c74c8d090c8b49a467516cf918e9c9f560380...a8c6d55ba0dab16ba857cca30fc958f72ac55a42 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc3c74c8d090c8b49a467516cf918e9c9f560380...a8c6d55ba0dab16ba857cca30fc958f72ac55a42 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 00:59:05 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Mar 2023 19:59:05 -0500 Subject: [Git][ghc/ghc][wip/T22264] 41 commits: rts: Drop redundant prototype Message-ID: <6407ddd99f1f3_2c78e9fc0691c304632@gitlab.mail> Ben Gamari pushed to branch wip/T22264 at Glasgow Haskell Compiler / GHC Commits: aa338394 by Ben Gamari at 2023-03-07T19:52:57-05:00 rts: Drop redundant prototype - - - - - 1ca730ce by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Fix style - - - - - 1cc4bd7a by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Deduplicate assertion - - - - - 8623ab4b by Ben Gamari at 2023-03-07T19:53:06-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - e04ad017 by Ben Gamari at 2023-03-07T19:53:06-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 3072bef5 by Ben Gamari at 2023-03-07T19:53:06-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 3223048a by Ben Gamari at 2023-03-07T19:53:06-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - ce4cf9d5 by Ben Gamari at 2023-03-07T19:53:06-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 9ce9fba4 by Ben Gamari at 2023-03-07T19:53:06-05:00 Evac: Squash data race in eval_selector_chain - - - - - ba3c7b67 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 883d00f9 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Clarify comment - - - - - ed5443ec by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - 244640a0 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 683e0c7a by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - 90e24004 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 2f082657 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 3288e96d by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 4392965d by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - d478ac18 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Assert state of swept segments - - - - - 3e47be78 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - 7dc1679b by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - bd80fcd1 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - e941801a by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Post-sweep sanity checking - - - - - 68fa47f3 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Avoid n_caps race - - - - - b15c8137 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - ca3bc402 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 02399888 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - 0c6f1576 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 5b60acba by Ben Gamari at 2023-03-07T19:53:06-05:00 rts: Reenable assertion - - - - - f8493745 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 43fda648 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - a9062eaa by Ben Gamari at 2023-03-07T19:53:06-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - b284e1c1 by Ben Gamari at 2023-03-07T19:53:06-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 9c9899d5 by Ben Gamari at 2023-03-07T19:53:07-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - 5e5c3032 by Ben Gamari at 2023-03-07T19:53:07-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - f2ef2f5e by Ben Gamari at 2023-03-07T19:53:07-05:00 nonmoving: Fix unregisterised build - - - - - 7cc7461c by Ben Gamari at 2023-03-07T19:53:07-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - ec382ccc by Ben Gamari at 2023-03-07T19:53:07-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - f27f75f5 by Ben Gamari at 2023-03-07T19:53:07-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - e6f7b809 by Ben Gamari at 2023-03-07T19:53:07-05:00 nonmoving: Move allocator into new source file - - - - - cfc68b5c by Ben Gamari at 2023-03-07T19:53:07-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - hadrian/src/Flavour.hs - libraries/ghc-heap/tests/all.T - rts/Capability.c - rts/Capability.h - rts/PrimOps.cmm - rts/RtsStartup.c - rts/RtsUtils.h - rts/Schedule.c - rts/Sparks.h - rts/ThreadLabels.c - rts/include/rts/storage/MBlock.h - rts/rts.cabal.in - rts/sm/BlockAlloc.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GC.h - rts/sm/GCUtils.c - rts/sm/GCUtils.h - rts/sm/HeapAlloc.h - rts/sm/MarkWeak.c - rts/sm/NonMoving.c - rts/sm/NonMoving.h - + rts/sm/NonMovingAllocate.c - + rts/sm/NonMovingAllocate.h - rts/sm/NonMovingCensus.c - rts/sm/NonMovingCensus.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/637a2b5e8d768c4db99ad1fb0f40290da093ea20...cfc68b5c9ee9000010ccb2b7f1d346542df3b79f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/637a2b5e8d768c4db99ad1fb0f40290da093ea20...cfc68b5c9ee9000010ccb2b7f1d346542df3b79f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 02:21:59 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Mar 2023 21:21:59 -0500 Subject: [Git][ghc/ghc][master] Add `Data.Functor.unzip` Message-ID: <6407f14711f9f_2c78e910f7c8ac3180cc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2 changed files: - libraries/base/Data/Functor.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/Data/Functor.hs ===================================== @@ -43,10 +43,12 @@ module Data.Functor ($>), (<$>), (<&>), + unzip, void, ) where import GHC.Base ( Functor(..), flip ) +import Data.Tuple ( fst, snd ) -- $setup -- Allow the use of Prelude in doctests. @@ -159,6 +161,9 @@ infixl 4 $> ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$) +unzip :: Functor f => f (a,b) -> (f a, f b) +unzip xs = (fst <$> xs, snd <$> xs) + -- | @'void' value@ discards or ignores the result of evaluation, such -- as the return value of an 'System.IO.IO' action. -- ===================================== libraries/base/changelog.md ===================================== @@ -11,6 +11,7 @@ ([CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113)) * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) + * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) ## 4.18.0.0 *TBA* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa559c28d22888a4ba497daca2c1d5afdebb716c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa559c28d22888a4ba497daca2c1d5afdebb716c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 02:22:40 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Mar 2023 21:22:40 -0500 Subject: [Git][ghc/ghc][master] Fix documentation for traceWith and friends Message-ID: <6407f1706bdea_2c78e910f944d432174a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - 2 changed files: - libraries/base/Debug/Trace.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/Debug/Trace.hs ===================================== @@ -173,7 +173,7 @@ Like 'trace', but outputs the result of calling a function on the argument. hello ("hello","world") - at since 4.17.0.0 + at since 4.18.0.0 -} traceWith :: (a -> String) -> a -> a traceWith f a = trace (f a) a @@ -186,7 +186,7 @@ a 'String'. 3 [1,2,3] - at since 4.17.0.0 + at since 4.18.0.0 -} traceShowWith :: Show b => (a -> b) -> a -> a traceShowWith f = traceWith (show . f) @@ -303,7 +303,7 @@ traceEventIO msg = -- | Like 'traceEvent', but emits the result of calling a function on its -- argument. -- --- @since 4.17.0.0 +-- @since 4.18.0.0 traceEventWith :: (a -> String) -> a -> a traceEventWith f a = traceEvent (f a) a ===================================== libraries/base/changelog.md ===================================== @@ -83,6 +83,9 @@ * `InfoProv` now has additional `ipSrcFile` and `ipSrcSpan` fields. `ipLoc` is now a function computed from these fields. * The `whereFrom` function has been moved + * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to + `Debug.Trace`, per + [CLC proposal #36](https://github.com/haskell/core-libraries-committee/issues/36). ## 4.17.0.0 *August 2022* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2aa0770845631e4355f55694f49b3e4b66ecf751 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2aa0770845631e4355f55694f49b3e4b66ecf751 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 03:41:11 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Mar 2023 22:41:11 -0500 Subject: [Git][ghc/ghc][wip/T22264] 7 commits: testsuite: Only run T22795* in the normal way Message-ID: <640803d75ece0_2c78e912d2d16c333620@gitlab.mail> Ben Gamari pushed to branch wip/T22264 at Glasgow Haskell Compiler / GHC Commits: 6f93d1ab by Ben Gamari at 2023-03-07T20:23:29-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 6a698354 by Ben Gamari at 2023-03-07T21:07:32-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 2ab96142 by Ben Gamari at 2023-03-07T22:13:19-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - e76488f3 by Ben Gamari at 2023-03-07T22:13:19-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - 69863e58 by Ben Gamari at 2023-03-07T22:13:19-05:00 nonmoving: Non-concurrent collection - - - - - 09bc4845 by Ben Gamari at 2023-03-07T22:33:46-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - 6cb91e16 by Ben Gamari at 2023-03-07T22:40:39-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - 13 changed files: - rts/Schedule.c - rts/include/rts/storage/GC.h - rts/sm/GC.c - rts/sm/GC.h - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingSweep.c - rts/sm/Storage.c - rts/sm/Storage.h - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ffi/should_run/ffi023_c.c - testsuite/tests/rts/all.T Changes: ===================================== rts/Schedule.c ===================================== @@ -157,7 +157,10 @@ static bool scheduleHandleThreadFinished( Capability *cap, Task *task, StgTSO *t ); static bool scheduleNeedHeapProfile(bool ready_to_gc); static void scheduleDoGC( Capability **pcap, Task *task, - bool force_major, bool is_overflow_gc, bool deadlock_detect ); + bool force_major, + bool is_overflow_gc, + bool deadlock_detect, + bool nonconcurrent ); static void deleteThread (StgTSO *tso); static void deleteAllThreads (void); @@ -259,7 +262,7 @@ schedule (Capability *initialCapability, Task *task) case SCHED_INTERRUPTING: debugTrace(DEBUG_sched, "SCHED_INTERRUPTING"); /* scheduleDoGC() deletes all the threads */ - scheduleDoGC(&cap,task,true,false,false); + scheduleDoGC(&cap,task,true,false,false,false); // after scheduleDoGC(), we must be shutting down. Either some // other Capability did the final GC, or we did it above, @@ -572,7 +575,7 @@ run_thread: } if (ready_to_gc || scheduleNeedHeapProfile(ready_to_gc)) { - scheduleDoGC(&cap,task,false,ready_to_gc,false); + scheduleDoGC(&cap,task,false,ready_to_gc,false,false); } } /* end of while() */ } @@ -966,7 +969,7 @@ scheduleDetectDeadlock (Capability **pcap, Task *task) // they are unreachable and will therefore be sent an // exception. Any threads thus released will be immediately // runnable. - scheduleDoGC (pcap, task, true/*force major GC*/, false /* Whether it is an overflow GC */, true/*deadlock detection*/); + scheduleDoGC (pcap, task, true/*force major GC*/, false /* Whether it is an overflow GC */, true/*deadlock detection*/, false/*nonconcurrent*/); cap = *pcap; // when force_major == true. scheduleDoGC sets // recent_activity to ACTIVITY_DONE_GC and turns off the timer @@ -1015,7 +1018,7 @@ scheduleProcessInbox (Capability **pcap USED_IF_THREADS) while (!emptyInbox(cap)) { // Executing messages might use heap, so we should check for GC. if (doYouWantToGC(cap)) { - scheduleDoGC(pcap, cap->running_task, false, false, false); + scheduleDoGC(pcap, cap->running_task, false, false, false, false); cap = *pcap; } @@ -1583,7 +1586,10 @@ void releaseAllCapabilities(uint32_t n, Capability *keep_cap, Task *task) // behind deadlock_detect argument. static void scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, - bool force_major, bool is_overflow_gc, bool deadlock_detect) + bool force_major, + bool is_overflow_gc, + bool deadlock_detect, + bool nonconcurrent) { Capability *cap = *pcap; bool heap_census; @@ -1873,14 +1879,23 @@ delete_threads_and_gc: // Do any remaining idle GC work from the previous GC doIdleGCWork(cap, true /* all of it */); + struct GcConfig config = { + .collect_gen = collect_gen, + .do_heap_census = heap_census, + .overflow_gc = is_overflow_gc, + .deadlock_detect = deadlock_detect, + .nonconcurrent = nonconcurrent + }; + #if defined(THREADED_RTS) // reset pending_sync *before* GC, so that when the GC threads // emerge they don't immediately re-enter the GC. RELAXED_STORE(&pending_sync, 0); signalCondition(&sync_finished_cond); - GarbageCollect(collect_gen, heap_census, is_overflow_gc, deadlock_detect, gc_type, cap, idle_cap); + config.parallel = gc_type == SYNC_GC_PAR; + GarbageCollect(config, cap, idle_cap); #else - GarbageCollect(collect_gen, heap_census, is_overflow_gc, deadlock_detect, 0, cap, NULL); + GarbageCollect(config, cap, NULL); #endif // If we're shutting down, don't leave any idle GC work to do. @@ -2770,7 +2785,7 @@ exitScheduler (bool wait_foreign USED_IF_THREADS) nonmovingStop(); Capability *cap = task->cap; waitForCapability(&cap,task); - scheduleDoGC(&cap,task,true,false,false); + scheduleDoGC(&cap,task,true,false,false,true); ASSERT(task->incall->tso == NULL); releaseCapability(cap); } @@ -2815,7 +2830,7 @@ freeScheduler( void ) -------------------------------------------------------------------------- */ static void -performGC_(bool force_major) +performGC_(bool force_major, bool nonconcurrent) { Task *task; Capability *cap = NULL; @@ -2828,7 +2843,7 @@ performGC_(bool force_major) // TODO: do we need to traceTask*() here? waitForCapability(&cap,task); - scheduleDoGC(&cap,task,force_major,false,false); + scheduleDoGC(&cap,task,force_major,false,false,nonconcurrent); releaseCapability(cap); exitMyTask(); } @@ -2836,13 +2851,19 @@ performGC_(bool force_major) void performGC(void) { - performGC_(false); + performGC_(false, false); } void performMajorGC(void) { - performGC_(true); + performGC_(true, false); +} + +void +performBlockingMajorGC(void) +{ + performGC_(true, true); } /* --------------------------------------------------------------------------- ===================================== rts/include/rts/storage/GC.h ===================================== @@ -215,6 +215,7 @@ extern W_ large_alloc_lim; void performGC(void); void performMajorGC(void); +void performBlockingMajorGC(void); /* ----------------------------------------------------------------------------- The CAF table - used to let us revert CAFs in GHCi ===================================== rts/sm/GC.c ===================================== @@ -278,11 +278,7 @@ addMutListScavStats(const MutListScavStats *src, -------------------------------------------------------------------------- */ void -GarbageCollect (uint32_t collect_gen, - const bool do_heap_census, - const bool is_overflow_gc, - const bool deadlock_detect, - uint32_t gc_type USED_IF_THREADS, +GarbageCollect (struct GcConfig config, Capability *cap, bool idle_cap[]) { @@ -298,7 +294,7 @@ GarbageCollect (uint32_t collect_gen, // The time we should report our heap census as occurring at, if necessary. Time mut_time = 0; - if (do_heap_census) { + if (config.do_heap_census) { RTSStats stats; getRTSStats(&stats); mut_time = stats.mutator_cpu_ns; @@ -307,6 +303,8 @@ GarbageCollect (uint32_t collect_gen, // necessary if we stole a callee-saves register for gct: #if defined(THREADED_RTS) saved_gct = gct; +#else + ASSERT(!config.parallel); #endif #if defined(PROFILING) @@ -349,11 +347,11 @@ GarbageCollect (uint32_t collect_gen, /* Figure out which generation to collect */ - N = collect_gen; + N = config.collect_gen; major_gc = (N == RtsFlags.GcFlags.generations-1); /* See Note [Deadlock detection under the nonmoving collector]. */ - deadlock_detect_gc = deadlock_detect; + deadlock_detect_gc = config.deadlock_detect; #if defined(THREADED_RTS) if (major_gc && RtsFlags.GcFlags.useNonmoving && RELAXED_LOAD(&concurrent_coll_running)) { @@ -362,7 +360,7 @@ GarbageCollect (uint32_t collect_gen, * TODO: Catch heap-size runaway. */ N--; - collect_gen--; + config.collect_gen--; major_gc = false; } #endif @@ -397,7 +395,7 @@ GarbageCollect (uint32_t collect_gen, * we set n_gc_threads, work_stealing, n_gc_idle_threads, gc_running_threads * here */ - if (gc_type == SYNC_GC_PAR) { + if (config.parallel) { n_gc_threads = getNumCapabilities(); n_gc_idle_threads = 0; for (uint32_t i = 0; i < getNumCapabilities(); ++i) { @@ -858,6 +856,8 @@ GarbageCollect (uint32_t collect_gen, // oldest_gen->scavenged_large_objects back to oldest_gen->large_objects. ASSERT(oldest_gen->scavenged_large_objects == NULL); if (RtsFlags.GcFlags.useNonmoving && major_gc) { + bool concurrent = false; + // All threads in non-moving heap should be found to be alive, because // threads in the non-moving generation's list should live in the // non-moving heap, and we consider non-moving objects alive during @@ -871,18 +871,21 @@ GarbageCollect (uint32_t collect_gen, // old_weak_ptr_list should be empty. ASSERT(oldest_gen->old_weak_ptr_list == NULL); +#if defined(THREADED_RTS) + concurrent = !config.nonconcurrent; +#else + // In the non-threaded runtime this is the only time we push to the + // upd_rem_set + nonmovingAddUpdRemSetBlocks(&gct->cap->upd_rem_set); +#endif + // dead_weak_ptr_list contains weak pointers with dead keys. Those need to // be kept alive because we'll use them in finalizeSchedulers(). Similarly // resurrected_threads are also going to be used in resurrectedThreads() // so we need to mark those too. // Note that in sequential case these lists will be appended with more // weaks and threads found to be dead in mark. -#if !defined(THREADED_RTS) - // In the non-threaded runtime this is the only time we push to the - // upd_rem_set - nonmovingAddUpdRemSetBlocks(&gct->cap->upd_rem_set); -#endif - nonmovingCollect(&dead_weak_ptr_list, &resurrected_threads); + nonmovingCollect(&dead_weak_ptr_list, &resurrected_threads, concurrent); } // Update the max size of older generations after a major GC: @@ -963,7 +966,7 @@ GarbageCollect (uint32_t collect_gen, // resurrectThreads(), for the same reason as checkSanity above: // resurrectThreads() will overwrite some closures and leave slop // behind. - if (do_heap_census) { + if (config.do_heap_census) { debugTrace(DEBUG_sched, "performing heap census"); RELEASE_SM_LOCK; heapCensus(mut_time); @@ -1014,7 +1017,7 @@ GarbageCollect (uint32_t collect_gen, #endif // Reset the counter if the major GC was caused by a heap overflow - consec_idle_gcs = is_overflow_gc ? 0 : consec_idle_gcs + 1; + consec_idle_gcs = config.overflow_gc ? 0 : consec_idle_gcs + 1; // See Note [Scaling retained memory] double scaled_factor = ===================================== rts/sm/GC.h ===================================== @@ -17,11 +17,23 @@ #include "BeginPrivate.h" -void GarbageCollect (uint32_t collect_gen, - bool do_heap_census, - bool is_overflow_gc, - bool deadlock_detect, - uint32_t gc_type, +struct GcConfig { + // which generation are we requesting be collected? + uint32_t collect_gen; + // is a heap census requested? + bool do_heap_census; + // is this GC triggered by a heap overflow? + bool overflow_gc; + // is this GC triggered by a deadlock? + bool deadlock_detect; + // should we force non-concurrent collection if the non-moving collector is + // being used? + bool nonconcurrent; + // should we use parallel scavenging? + bool parallel; +}; + +void GarbageCollect (struct GcConfig config, Capability *cap, bool idle_cap[]); ===================================== rts/sm/NonMoving.c ===================================== @@ -548,7 +548,7 @@ MarkBudget sync_phase_marking_budget = 200000; #if defined(THREADED_RTS) static void* nonmovingConcurrentMark(void *mark_queue); #endif -static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO **resurrected_threads); +static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO **resurrected_threads, bool concurrent); // Add a segment to the free list. void nonmovingPushFreeSegment(struct NonmovingSegment *seg) @@ -712,7 +712,7 @@ static void nonmovingPrepareMark(void) #endif } -void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) +void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads, bool concurrent STG_UNUSED) { #if defined(THREADED_RTS) // We can't start a new collection until the old one has finished @@ -799,7 +799,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) } trace(TRACE_nonmoving_gc, "Finished nonmoving GC preparation"); - // We are now safe to start concurrent marking + // We are now safe to start (possibly concurrent) marking // Note that in concurrent mark we can't use dead_weaks and // resurrected_threads from the preparation to add new weaks and threads as @@ -807,13 +807,17 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) // those lists to mark function in sequential case. In concurrent case we // allocate fresh lists. -#if defined(THREADED_RTS) // If we're interrupting or shutting down, do not let this capability go and // run a STW collection. Reason: we won't be able to acquire this capability // again for the sync if we let it go, because it'll immediately start doing // a major GC, because that's what we do when exiting scheduler (see // exitScheduler()). - if (getSchedState() == SCHED_RUNNING) { + if (getSchedState() != SCHED_RUNNING) { + concurrent = false; + } + +#if defined(THREADED_RTS) + if (concurrent) { RELAXED_STORE(&concurrent_coll_running, true); nonmoving_write_barrier_enabled = true; debugTrace(DEBUG_nonmoving_gc, "Starting concurrent mark thread"); @@ -823,14 +827,19 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) barf("nonmovingCollect: failed to spawn mark thread: %s", strerror(errno)); } RELAXED_STORE(&mark_thread, thread); + return; } else { - nonmovingConcurrentMark(mark_queue); + RELEASE_SM_LOCK; } -#else +#endif + // Use the weak and thread lists from the preparation for any new weaks and // threads found to be dead in mark. - nonmovingMark_(mark_queue, dead_weaks, resurrected_threads); -#endif + nonmovingMark_(mark_queue, dead_weaks, resurrected_threads, false); + + if (!concurrent) { + ACQUIRE_SM_LOCK; + } } /* Mark queue, threads, and weak pointers until no more weaks have been @@ -862,7 +871,7 @@ static void* nonmovingConcurrentMark(void *data) MarkQueue *mark_queue = (MarkQueue*)data; StgWeak *dead_weaks = NULL; StgTSO *resurrected_threads = (StgTSO*)&stg_END_TSO_QUEUE_closure; - nonmovingMark_(mark_queue, &dead_weaks, &resurrected_threads); + nonmovingMark_(mark_queue, &dead_weaks, &resurrected_threads, true); return NULL; } @@ -876,8 +885,11 @@ static void appendWeakList( StgWeak **w1, StgWeak *w2 ) } #endif -static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO **resurrected_threads) +static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO **resurrected_threads, bool concurrent) { +#if !defined(THREADED_RTS) + ASSERT(!concurrent); +#endif ACQUIRE_LOCK(&nonmoving_collection_mutex); debugTrace(DEBUG_nonmoving_gc, "Starting mark..."); stat_startNonmovingGc(); @@ -920,38 +932,41 @@ concurrent_marking: } #if defined(THREADED_RTS) - Task *task = newBoundTask(); - - // If at this point if we've decided to exit then just return - if (getSchedState() > SCHED_RUNNING) { - // Note that we break our invariants here and leave segments in - // nonmovingHeap.sweep_list, don't free nonmoving_large_objects etc. - // However because we won't be running sweep in the final GC this - // is OK. - // - // However, we must move any weak pointers remaining on - // nonmoving_old_weak_ptr_list back to nonmoving_weak_ptr_list - // such that their C finalizers can be run by hs_exit_. - appendWeakList(&nonmoving_weak_ptr_list, nonmoving_old_weak_ptr_list); - goto finish; - } - - // We're still running, request a sync - nonmovingBeginFlush(task); - - bool all_caps_syncd; - MarkBudget sync_marking_budget = sync_phase_marking_budget; - do { - all_caps_syncd = nonmovingWaitForFlush(); - if (nonmovingMarkThreadsWeaks(&sync_marking_budget, mark_queue) == false) { - // We ran out of budget for marking. Abort sync. - // See Note [Sync phase marking budget]. - traceConcSyncEnd(); - stat_endNonmovingGcSync(); - releaseAllCapabilities(n_capabilities, NULL, task); - goto concurrent_marking; + Task *task = NULL; + if (concurrent) { + task = newBoundTask(); + + // If at this point if we've decided to exit then just return + if (getSchedState() > SCHED_RUNNING) { + // Note that we break our invariants here and leave segments in + // nonmovingHeap.sweep_list, don't free nonmoving_large_objects etc. + // However because we won't be running sweep in the final GC this + // is OK. + // + // However, we must move any weak pointers remaining on + // nonmoving_old_weak_ptr_list back to nonmoving_weak_ptr_list + // such that their C finalizers can be run by hs_exit_. + appendWeakList(&nonmoving_weak_ptr_list, nonmoving_old_weak_ptr_list); + goto finish; } - } while (!all_caps_syncd); + + // We're still running, request a sync + nonmovingBeginFlush(task); + + bool all_caps_syncd; + MarkBudget sync_marking_budget = sync_phase_marking_budget; + do { + all_caps_syncd = nonmovingWaitForFlush(); + if (nonmovingMarkThreadsWeaks(&sync_marking_budget, mark_queue) == false) { + // We ran out of budget for marking. Abort sync. + // See Note [Sync phase marking budget]. + traceConcSyncEnd(); + stat_endNonmovingGcSync(); + releaseAllCapabilities(n_capabilities, NULL, task); + goto concurrent_marking; + } + } while (!all_caps_syncd); + } #endif nonmovingResurrectThreads(mark_queue, resurrected_threads); @@ -981,15 +996,15 @@ concurrent_marking: // Schedule finalizers and resurrect threads -#if defined(THREADED_RTS) - // Just pick a random capability. Not sure if this is a good idea -- we use - // only one capability for all finalizers. - scheduleFinalizers(getCapability(0), *dead_weaks); - // Note that this mutates heap and causes running write barriers. - // See Note [Unintentional marking in resurrectThreads] in NonMovingMark.c - // for how we deal with this. - resurrectThreads(*resurrected_threads); -#endif + if (concurrent) { + // Just pick a random capability. Not sure if this is a good idea -- we use + // only one capability for all finalizers. + scheduleFinalizers(getCapability(0), *dead_weaks); + // Note that this mutates heap and causes running write barriers. + // See Note [Unintentional marking in resurrectThreads] in NonMovingMark.c + // for how we deal with this. + resurrectThreads(*resurrected_threads); + } #if defined(DEBUG) // Zap CAFs that we will sweep @@ -1019,15 +1034,19 @@ concurrent_marking: // Prune spark lists // See Note [Spark management under the nonmoving collector]. #if defined(THREADED_RTS) - for (uint32_t n = 0; n < getNumCapabilities(); n++) { - pruneSparkQueue(true, getCapability(n)); + if (concurrent) { + for (uint32_t n = 0; n < getNumCapabilities(); n++) { + pruneSparkQueue(true, getCapability(n)); + } } -#endif // Everything has been marked; allow the mutators to proceed -#if defined(THREADED_RTS) && !defined(NONCONCURRENT_SWEEP) - nonmoving_write_barrier_enabled = false; - nonmovingFinishFlush(task); +#if !defined(NONCONCURRENT_SWEEP) + if (concurrent) { + nonmoving_write_barrier_enabled = false; + nonmovingFinishFlush(task); + } +#endif #endif current_mark_queue = NULL; @@ -1064,24 +1083,28 @@ concurrent_marking: nonmovingTraceAllocatorCensus(); #endif -#if defined(THREADED_RTS) && defined(NONCONCURRENT_SWEEP) +#if defined(NONCONCURRENT_SWEEP) #if defined(DEBUG) checkNonmovingHeap(&nonmovingHeap); checkSanity(true, true); #endif - nonmoving_write_barrier_enabled = false; - nonmovingFinishFlush(task); + if (concurrent) { + nonmoving_write_barrier_enabled = false; + nonmovingFinishFlush(task); + } #endif // TODO: Remainder of things done by GarbageCollect (update stats) #if defined(THREADED_RTS) finish: - exitMyTask(); + if (concurrent) { + exitMyTask(); - // We are done... - RELAXED_STORE(&mark_thread, 0); - stat_endNonmovingGc(); + // We are done... + RELAXED_STORE(&mark_thread, 0); + stat_endNonmovingGc(); + } // Signal that the concurrent collection is finished, allowing the next // non-moving collection to proceed ===================================== rts/sm/NonMoving.h ===================================== @@ -149,7 +149,8 @@ void nonmovingExit(void); // directly, but in a pause. // void nonmovingCollect(StgWeak **dead_weaks, - StgTSO **resurrected_threads); + StgTSO **resurrected_threads, + bool concurrent); void nonmovingPushFreeSegment(struct NonmovingSegment *seg); @@ -361,9 +362,9 @@ void print_thread_list(StgTSO* tso); #endif -RTS_PRIVATE void clear_segment(struct NonmovingSegment*); +RTS_PRIVATE void nonmovingClearSegment(struct NonmovingSegment*); -RTS_PRIVATE void clear_segment_free_blocks(struct NonmovingSegment*); +RTS_PRIVATE void nonmovingClearSegmentFreeBlocks(struct NonmovingSegment*); #include "EndPrivate.h" ===================================== rts/sm/NonMovingMark.c ===================================== @@ -27,8 +27,10 @@ #include "sm/Storage.h" #include "CNF.h" +#if defined(THREADED_RTS) static void nonmovingResetUpdRemSetQueue (MarkQueue *rset); static void nonmovingResetUpdRemSet (UpdRemSet *rset); +#endif static bool check_in_nonmoving_heap(StgClosure *p); static void mark_closure (MarkQueue *queue, const StgClosure *p, StgClosure **origin); static void trace_tso (MarkQueue *queue, StgTSO *tso); @@ -955,6 +957,7 @@ void nonmovingInitUpdRemSet (UpdRemSet *rset) rset->queue.is_upd_rem_set = true; } +#if defined(THREADED_RTS) static void nonmovingResetUpdRemSetQueue (MarkQueue *rset) { // UpdRemSets always have one block for the mark queue. This assertion is to @@ -968,6 +971,7 @@ void nonmovingResetUpdRemSet (UpdRemSet *rset) { nonmovingResetUpdRemSetQueue(&rset->queue); } +#endif void freeMarkQueue (MarkQueue *queue) { ===================================== rts/sm/NonMovingSweep.c ===================================== @@ -110,14 +110,14 @@ void nonmovingGcCafs() #endif void -clear_segment(struct NonmovingSegment* seg) +nonmovingClearSegment(struct NonmovingSegment* seg) { size_t end = ((size_t)seg) + NONMOVING_SEGMENT_SIZE; memset(&seg->bitmap, 0, end - (size_t)&seg->bitmap); } void -clear_segment_free_blocks(struct NonmovingSegment* seg) +nonmovingClearSegmentFreeBlocks(struct NonmovingSegment* seg) { unsigned int block_size = nonmovingSegmentBlockSize(seg); for (unsigned int p_idx = 0; p_idx < nonmovingSegmentBlockCount(seg); ++p_idx) { @@ -142,11 +142,11 @@ GNUC_ATTR_HOT void nonmovingSweep(void) switch (ret) { case SEGMENT_FREE: - IF_DEBUG(sanity, clear_segment(seg)); + IF_DEBUG(sanity, nonmovingClearSegment(seg)); nonmovingPushFreeSegment(seg); break; case SEGMENT_PARTIAL: - IF_DEBUG(sanity, clear_segment_free_blocks(seg)); + IF_DEBUG(sanity, nonmovingClearSegmentFreeBlocks(seg)); nonmovingPushActiveSegment(seg); break; case SEGMENT_FILLED: ===================================== rts/sm/Storage.c ===================================== @@ -1942,19 +1942,19 @@ void rts_clearMemory(void) { if (RtsFlags.GcFlags.useNonmoving) { for (struct NonmovingSegment *seg = nonmovingHeap.free; seg; seg = seg->link) { - clear_segment(seg); + nonmovingClearSegment(seg); } for (int i = 0; i < NONMOVING_ALLOCA_CNT; ++i) { struct NonmovingAllocator *alloc = &nonmovingHeap.allocators[i]; for (struct NonmovingSegment *seg = alloc->active; seg; seg = seg->link) { - clear_segment_free_blocks(seg); + nonmovingClearSegmentFreeBlocks(seg); } for (unsigned int j = 0; j < getNumCapabilities(); ++j) { Capability *cap = getCapability(j); - clear_segment_free_blocks(cap->current_segments[i]); + nonmovingClearSegmentFreeBlocks(cap->current_segments[i]); } } } ===================================== rts/sm/Storage.h ===================================== @@ -215,7 +215,7 @@ extern StgIndStatic * dyn_caf_list; extern StgIndStatic * debug_caf_list; extern StgIndStatic * revertible_caf_list; -STATIC_INLINE void clear_blocks(bdescr *bd) { +INLINE_HEADER void clear_blocks(bdescr *bd) { memset(bd->start, 0, BLOCK_SIZE * bd->blocks); } ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -191,6 +191,7 @@ test('T8083', [omit_ways(['ghci']), req_c], compile_and_run, ['T8083_c.c']) test('T9274', [omit_ways(['ghci'])], compile_and_run, ['']) test('ffi023', [ omit_ways(['ghci']), + expect_broken_for(23089, ['threaded2', 'nonmoving_thr', 'nonmoving_thr_sanity', 'nonmoving_thr_ghc']), extra_run_opts('1000 4'), js_broken(22363), pre_cmd('$MAKE -s --no-print-directory ffi023_setup') ], ===================================== testsuite/tests/ffi/should_run/ffi023_c.c ===================================== @@ -4,7 +4,7 @@ HsInt out (HsInt x) { - performMajorGC(); + performBlockingMajorGC(); rts_clearMemory(); return incall(x); } ===================================== testsuite/tests/rts/all.T ===================================== @@ -261,8 +261,8 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) -test('T7160', [ # finalization order is too nondeterministic in the concurrent GC - omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc', 'nonmoving_thr_sanity']) +test('T7160', [ # finalization order is different in the nonmoving + omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', 'nonmoving_thr_sanity']) , js_broken(22261) ], compile_and_run, ['']) @@ -570,6 +570,6 @@ test('decodeMyStack_emptyListForMissingFlag', ], compile_and_run, ['']) # Skip for JS platform as the JS RTS is always single threaded -test('T22795a', [js_skip], compile_and_run, ['-threaded']) -test('T22795b', [js_skip], compile_and_run, ['-single-threaded']) -test('T22795c', [js_skip], compile_and_run, ['-threaded -single-threaded']) +test('T22795a', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded']) +test('T22795b', [only_ways(['normal']), js_skip], compile_and_run, ['-single-threaded']) +test('T22795c', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded -single-threaded']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cfc68b5c9ee9000010ccb2b7f1d346542df3b79f...6cb91e16d661f9ef755c5fc399cf90b82368b43b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cfc68b5c9ee9000010ccb2b7f1d346542df3b79f...6cb91e16d661f9ef755c5fc399cf90b82368b43b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 03:41:37 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 07 Mar 2023 22:41:37 -0500 Subject: [Git][ghc/ghc][wip/T22264] 4 commits: testsuite: Mark ffi023 as broken due to #23089 Message-ID: <640803f1aef54_2c78e912d2d33833448e@gitlab.mail> Ben Gamari pushed to branch wip/T22264 at Glasgow Haskell Compiler / GHC Commits: 600fdd58 by Ben Gamari at 2023-03-07T22:41:27-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - 9c9bd1af by Ben Gamari at 2023-03-07T22:41:27-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - ac0240af by Ben Gamari at 2023-03-07T22:41:27-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - be9b4ca4 by Ben Gamari at 2023-03-07T22:41:27-05:00 nonmoving: Non-concurrent collection - - - - - 10 changed files: - rts/Schedule.c - rts/include/rts/storage/GC.h - rts/sm/GC.c - rts/sm/GC.h - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingMark.c - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ffi/should_run/ffi023_c.c - testsuite/tests/rts/all.T Changes: ===================================== rts/Schedule.c ===================================== @@ -157,7 +157,10 @@ static bool scheduleHandleThreadFinished( Capability *cap, Task *task, StgTSO *t ); static bool scheduleNeedHeapProfile(bool ready_to_gc); static void scheduleDoGC( Capability **pcap, Task *task, - bool force_major, bool is_overflow_gc, bool deadlock_detect ); + bool force_major, + bool is_overflow_gc, + bool deadlock_detect, + bool nonconcurrent ); static void deleteThread (StgTSO *tso); static void deleteAllThreads (void); @@ -259,7 +262,7 @@ schedule (Capability *initialCapability, Task *task) case SCHED_INTERRUPTING: debugTrace(DEBUG_sched, "SCHED_INTERRUPTING"); /* scheduleDoGC() deletes all the threads */ - scheduleDoGC(&cap,task,true,false,false); + scheduleDoGC(&cap,task,true,false,false,false); // after scheduleDoGC(), we must be shutting down. Either some // other Capability did the final GC, or we did it above, @@ -572,7 +575,7 @@ run_thread: } if (ready_to_gc || scheduleNeedHeapProfile(ready_to_gc)) { - scheduleDoGC(&cap,task,false,ready_to_gc,false); + scheduleDoGC(&cap,task,false,ready_to_gc,false,false); } } /* end of while() */ } @@ -966,7 +969,7 @@ scheduleDetectDeadlock (Capability **pcap, Task *task) // they are unreachable and will therefore be sent an // exception. Any threads thus released will be immediately // runnable. - scheduleDoGC (pcap, task, true/*force major GC*/, false /* Whether it is an overflow GC */, true/*deadlock detection*/); + scheduleDoGC (pcap, task, true/*force major GC*/, false /* Whether it is an overflow GC */, true/*deadlock detection*/, false/*nonconcurrent*/); cap = *pcap; // when force_major == true. scheduleDoGC sets // recent_activity to ACTIVITY_DONE_GC and turns off the timer @@ -1015,7 +1018,7 @@ scheduleProcessInbox (Capability **pcap USED_IF_THREADS) while (!emptyInbox(cap)) { // Executing messages might use heap, so we should check for GC. if (doYouWantToGC(cap)) { - scheduleDoGC(pcap, cap->running_task, false, false, false); + scheduleDoGC(pcap, cap->running_task, false, false, false, false); cap = *pcap; } @@ -1583,7 +1586,10 @@ void releaseAllCapabilities(uint32_t n, Capability *keep_cap, Task *task) // behind deadlock_detect argument. static void scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, - bool force_major, bool is_overflow_gc, bool deadlock_detect) + bool force_major, + bool is_overflow_gc, + bool deadlock_detect, + bool nonconcurrent) { Capability *cap = *pcap; bool heap_census; @@ -1873,14 +1879,23 @@ delete_threads_and_gc: // Do any remaining idle GC work from the previous GC doIdleGCWork(cap, true /* all of it */); + struct GcConfig config = { + .collect_gen = collect_gen, + .do_heap_census = heap_census, + .overflow_gc = is_overflow_gc, + .deadlock_detect = deadlock_detect, + .nonconcurrent = nonconcurrent + }; + #if defined(THREADED_RTS) // reset pending_sync *before* GC, so that when the GC threads // emerge they don't immediately re-enter the GC. RELAXED_STORE(&pending_sync, 0); signalCondition(&sync_finished_cond); - GarbageCollect(collect_gen, heap_census, is_overflow_gc, deadlock_detect, gc_type, cap, idle_cap); + config.parallel = gc_type == SYNC_GC_PAR; + GarbageCollect(config, cap, idle_cap); #else - GarbageCollect(collect_gen, heap_census, is_overflow_gc, deadlock_detect, 0, cap, NULL); + GarbageCollect(config, cap, NULL); #endif // If we're shutting down, don't leave any idle GC work to do. @@ -2770,7 +2785,7 @@ exitScheduler (bool wait_foreign USED_IF_THREADS) nonmovingStop(); Capability *cap = task->cap; waitForCapability(&cap,task); - scheduleDoGC(&cap,task,true,false,false); + scheduleDoGC(&cap,task,true,false,false,true); ASSERT(task->incall->tso == NULL); releaseCapability(cap); } @@ -2815,7 +2830,7 @@ freeScheduler( void ) -------------------------------------------------------------------------- */ static void -performGC_(bool force_major) +performGC_(bool force_major, bool nonconcurrent) { Task *task; Capability *cap = NULL; @@ -2828,7 +2843,7 @@ performGC_(bool force_major) // TODO: do we need to traceTask*() here? waitForCapability(&cap,task); - scheduleDoGC(&cap,task,force_major,false,false); + scheduleDoGC(&cap,task,force_major,false,false,nonconcurrent); releaseCapability(cap); exitMyTask(); } @@ -2836,13 +2851,19 @@ performGC_(bool force_major) void performGC(void) { - performGC_(false); + performGC_(false, false); } void performMajorGC(void) { - performGC_(true); + performGC_(true, false); +} + +void +performBlockingMajorGC(void) +{ + performGC_(true, true); } /* --------------------------------------------------------------------------- ===================================== rts/include/rts/storage/GC.h ===================================== @@ -215,6 +215,7 @@ extern W_ large_alloc_lim; void performGC(void); void performMajorGC(void); +void performBlockingMajorGC(void); /* ----------------------------------------------------------------------------- The CAF table - used to let us revert CAFs in GHCi ===================================== rts/sm/GC.c ===================================== @@ -278,11 +278,7 @@ addMutListScavStats(const MutListScavStats *src, -------------------------------------------------------------------------- */ void -GarbageCollect (uint32_t collect_gen, - const bool do_heap_census, - const bool is_overflow_gc, - const bool deadlock_detect, - uint32_t gc_type USED_IF_THREADS, +GarbageCollect (struct GcConfig config, Capability *cap, bool idle_cap[]) { @@ -298,7 +294,7 @@ GarbageCollect (uint32_t collect_gen, // The time we should report our heap census as occurring at, if necessary. Time mut_time = 0; - if (do_heap_census) { + if (config.do_heap_census) { RTSStats stats; getRTSStats(&stats); mut_time = stats.mutator_cpu_ns; @@ -307,6 +303,8 @@ GarbageCollect (uint32_t collect_gen, // necessary if we stole a callee-saves register for gct: #if defined(THREADED_RTS) saved_gct = gct; +#else + ASSERT(!config.parallel); #endif #if defined(PROFILING) @@ -349,11 +347,11 @@ GarbageCollect (uint32_t collect_gen, /* Figure out which generation to collect */ - N = collect_gen; + N = config.collect_gen; major_gc = (N == RtsFlags.GcFlags.generations-1); /* See Note [Deadlock detection under the nonmoving collector]. */ - deadlock_detect_gc = deadlock_detect; + deadlock_detect_gc = config.deadlock_detect; #if defined(THREADED_RTS) if (major_gc && RtsFlags.GcFlags.useNonmoving && RELAXED_LOAD(&concurrent_coll_running)) { @@ -362,7 +360,7 @@ GarbageCollect (uint32_t collect_gen, * TODO: Catch heap-size runaway. */ N--; - collect_gen--; + config.collect_gen--; major_gc = false; } #endif @@ -397,7 +395,7 @@ GarbageCollect (uint32_t collect_gen, * we set n_gc_threads, work_stealing, n_gc_idle_threads, gc_running_threads * here */ - if (gc_type == SYNC_GC_PAR) { + if (config.parallel) { n_gc_threads = getNumCapabilities(); n_gc_idle_threads = 0; for (uint32_t i = 0; i < getNumCapabilities(); ++i) { @@ -858,6 +856,8 @@ GarbageCollect (uint32_t collect_gen, // oldest_gen->scavenged_large_objects back to oldest_gen->large_objects. ASSERT(oldest_gen->scavenged_large_objects == NULL); if (RtsFlags.GcFlags.useNonmoving && major_gc) { + bool concurrent = false; + // All threads in non-moving heap should be found to be alive, because // threads in the non-moving generation's list should live in the // non-moving heap, and we consider non-moving objects alive during @@ -871,18 +871,21 @@ GarbageCollect (uint32_t collect_gen, // old_weak_ptr_list should be empty. ASSERT(oldest_gen->old_weak_ptr_list == NULL); +#if defined(THREADED_RTS) + concurrent = !config.nonconcurrent; +#else + // In the non-threaded runtime this is the only time we push to the + // upd_rem_set + nonmovingAddUpdRemSetBlocks(&gct->cap->upd_rem_set); +#endif + // dead_weak_ptr_list contains weak pointers with dead keys. Those need to // be kept alive because we'll use them in finalizeSchedulers(). Similarly // resurrected_threads are also going to be used in resurrectedThreads() // so we need to mark those too. // Note that in sequential case these lists will be appended with more // weaks and threads found to be dead in mark. -#if !defined(THREADED_RTS) - // In the non-threaded runtime this is the only time we push to the - // upd_rem_set - nonmovingAddUpdRemSetBlocks(&gct->cap->upd_rem_set); -#endif - nonmovingCollect(&dead_weak_ptr_list, &resurrected_threads); + nonmovingCollect(&dead_weak_ptr_list, &resurrected_threads, concurrent); } // Update the max size of older generations after a major GC: @@ -963,7 +966,7 @@ GarbageCollect (uint32_t collect_gen, // resurrectThreads(), for the same reason as checkSanity above: // resurrectThreads() will overwrite some closures and leave slop // behind. - if (do_heap_census) { + if (config.do_heap_census) { debugTrace(DEBUG_sched, "performing heap census"); RELEASE_SM_LOCK; heapCensus(mut_time); @@ -1014,7 +1017,7 @@ GarbageCollect (uint32_t collect_gen, #endif // Reset the counter if the major GC was caused by a heap overflow - consec_idle_gcs = is_overflow_gc ? 0 : consec_idle_gcs + 1; + consec_idle_gcs = config.overflow_gc ? 0 : consec_idle_gcs + 1; // See Note [Scaling retained memory] double scaled_factor = ===================================== rts/sm/GC.h ===================================== @@ -17,11 +17,23 @@ #include "BeginPrivate.h" -void GarbageCollect (uint32_t collect_gen, - bool do_heap_census, - bool is_overflow_gc, - bool deadlock_detect, - uint32_t gc_type, +struct GcConfig { + // which generation are we requesting be collected? + uint32_t collect_gen; + // is a heap census requested? + bool do_heap_census; + // is this GC triggered by a heap overflow? + bool overflow_gc; + // is this GC triggered by a deadlock? + bool deadlock_detect; + // should we force non-concurrent collection if the non-moving collector is + // being used? + bool nonconcurrent; + // should we use parallel scavenging? + bool parallel; +}; + +void GarbageCollect (struct GcConfig config, Capability *cap, bool idle_cap[]); ===================================== rts/sm/NonMoving.c ===================================== @@ -548,7 +548,7 @@ MarkBudget sync_phase_marking_budget = 200000; #if defined(THREADED_RTS) static void* nonmovingConcurrentMark(void *mark_queue); #endif -static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO **resurrected_threads); +static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO **resurrected_threads, bool concurrent); // Add a segment to the free list. void nonmovingPushFreeSegment(struct NonmovingSegment *seg) @@ -712,7 +712,7 @@ static void nonmovingPrepareMark(void) #endif } -void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) +void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads, bool concurrent STG_UNUSED) { #if defined(THREADED_RTS) // We can't start a new collection until the old one has finished @@ -799,7 +799,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) } trace(TRACE_nonmoving_gc, "Finished nonmoving GC preparation"); - // We are now safe to start concurrent marking + // We are now safe to start (possibly concurrent) marking // Note that in concurrent mark we can't use dead_weaks and // resurrected_threads from the preparation to add new weaks and threads as @@ -807,13 +807,17 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) // those lists to mark function in sequential case. In concurrent case we // allocate fresh lists. -#if defined(THREADED_RTS) // If we're interrupting or shutting down, do not let this capability go and // run a STW collection. Reason: we won't be able to acquire this capability // again for the sync if we let it go, because it'll immediately start doing // a major GC, because that's what we do when exiting scheduler (see // exitScheduler()). - if (getSchedState() == SCHED_RUNNING) { + if (getSchedState() != SCHED_RUNNING) { + concurrent = false; + } + +#if defined(THREADED_RTS) + if (concurrent) { RELAXED_STORE(&concurrent_coll_running, true); nonmoving_write_barrier_enabled = true; debugTrace(DEBUG_nonmoving_gc, "Starting concurrent mark thread"); @@ -823,14 +827,19 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads) barf("nonmovingCollect: failed to spawn mark thread: %s", strerror(errno)); } RELAXED_STORE(&mark_thread, thread); + return; } else { - nonmovingConcurrentMark(mark_queue); + RELEASE_SM_LOCK; } -#else +#endif + // Use the weak and thread lists from the preparation for any new weaks and // threads found to be dead in mark. - nonmovingMark_(mark_queue, dead_weaks, resurrected_threads); -#endif + nonmovingMark_(mark_queue, dead_weaks, resurrected_threads, false); + + if (!concurrent) { + ACQUIRE_SM_LOCK; + } } /* Mark queue, threads, and weak pointers until no more weaks have been @@ -862,7 +871,7 @@ static void* nonmovingConcurrentMark(void *data) MarkQueue *mark_queue = (MarkQueue*)data; StgWeak *dead_weaks = NULL; StgTSO *resurrected_threads = (StgTSO*)&stg_END_TSO_QUEUE_closure; - nonmovingMark_(mark_queue, &dead_weaks, &resurrected_threads); + nonmovingMark_(mark_queue, &dead_weaks, &resurrected_threads, true); return NULL; } @@ -876,8 +885,11 @@ static void appendWeakList( StgWeak **w1, StgWeak *w2 ) } #endif -static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO **resurrected_threads) +static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO **resurrected_threads, bool concurrent) { +#if !defined(THREADED_RTS) + ASSERT(!concurrent); +#endif ACQUIRE_LOCK(&nonmoving_collection_mutex); debugTrace(DEBUG_nonmoving_gc, "Starting mark..."); stat_startNonmovingGc(); @@ -920,38 +932,41 @@ concurrent_marking: } #if defined(THREADED_RTS) - Task *task = newBoundTask(); - - // If at this point if we've decided to exit then just return - if (getSchedState() > SCHED_RUNNING) { - // Note that we break our invariants here and leave segments in - // nonmovingHeap.sweep_list, don't free nonmoving_large_objects etc. - // However because we won't be running sweep in the final GC this - // is OK. - // - // However, we must move any weak pointers remaining on - // nonmoving_old_weak_ptr_list back to nonmoving_weak_ptr_list - // such that their C finalizers can be run by hs_exit_. - appendWeakList(&nonmoving_weak_ptr_list, nonmoving_old_weak_ptr_list); - goto finish; - } - - // We're still running, request a sync - nonmovingBeginFlush(task); - - bool all_caps_syncd; - MarkBudget sync_marking_budget = sync_phase_marking_budget; - do { - all_caps_syncd = nonmovingWaitForFlush(); - if (nonmovingMarkThreadsWeaks(&sync_marking_budget, mark_queue) == false) { - // We ran out of budget for marking. Abort sync. - // See Note [Sync phase marking budget]. - traceConcSyncEnd(); - stat_endNonmovingGcSync(); - releaseAllCapabilities(n_capabilities, NULL, task); - goto concurrent_marking; + Task *task = NULL; + if (concurrent) { + task = newBoundTask(); + + // If at this point if we've decided to exit then just return + if (getSchedState() > SCHED_RUNNING) { + // Note that we break our invariants here and leave segments in + // nonmovingHeap.sweep_list, don't free nonmoving_large_objects etc. + // However because we won't be running sweep in the final GC this + // is OK. + // + // However, we must move any weak pointers remaining on + // nonmoving_old_weak_ptr_list back to nonmoving_weak_ptr_list + // such that their C finalizers can be run by hs_exit_. + appendWeakList(&nonmoving_weak_ptr_list, nonmoving_old_weak_ptr_list); + goto finish; } - } while (!all_caps_syncd); + + // We're still running, request a sync + nonmovingBeginFlush(task); + + bool all_caps_syncd; + MarkBudget sync_marking_budget = sync_phase_marking_budget; + do { + all_caps_syncd = nonmovingWaitForFlush(); + if (nonmovingMarkThreadsWeaks(&sync_marking_budget, mark_queue) == false) { + // We ran out of budget for marking. Abort sync. + // See Note [Sync phase marking budget]. + traceConcSyncEnd(); + stat_endNonmovingGcSync(); + releaseAllCapabilities(n_capabilities, NULL, task); + goto concurrent_marking; + } + } while (!all_caps_syncd); + } #endif nonmovingResurrectThreads(mark_queue, resurrected_threads); @@ -981,15 +996,15 @@ concurrent_marking: // Schedule finalizers and resurrect threads -#if defined(THREADED_RTS) - // Just pick a random capability. Not sure if this is a good idea -- we use - // only one capability for all finalizers. - scheduleFinalizers(getCapability(0), *dead_weaks); - // Note that this mutates heap and causes running write barriers. - // See Note [Unintentional marking in resurrectThreads] in NonMovingMark.c - // for how we deal with this. - resurrectThreads(*resurrected_threads); -#endif + if (concurrent) { + // Just pick a random capability. Not sure if this is a good idea -- we use + // only one capability for all finalizers. + scheduleFinalizers(getCapability(0), *dead_weaks); + // Note that this mutates heap and causes running write barriers. + // See Note [Unintentional marking in resurrectThreads] in NonMovingMark.c + // for how we deal with this. + resurrectThreads(*resurrected_threads); + } #if defined(DEBUG) // Zap CAFs that we will sweep @@ -1019,15 +1034,19 @@ concurrent_marking: // Prune spark lists // See Note [Spark management under the nonmoving collector]. #if defined(THREADED_RTS) - for (uint32_t n = 0; n < getNumCapabilities(); n++) { - pruneSparkQueue(true, getCapability(n)); + if (concurrent) { + for (uint32_t n = 0; n < getNumCapabilities(); n++) { + pruneSparkQueue(true, getCapability(n)); + } } -#endif // Everything has been marked; allow the mutators to proceed -#if defined(THREADED_RTS) && !defined(NONCONCURRENT_SWEEP) - nonmoving_write_barrier_enabled = false; - nonmovingFinishFlush(task); +#if !defined(NONCONCURRENT_SWEEP) + if (concurrent) { + nonmoving_write_barrier_enabled = false; + nonmovingFinishFlush(task); + } +#endif #endif current_mark_queue = NULL; @@ -1064,24 +1083,28 @@ concurrent_marking: nonmovingTraceAllocatorCensus(); #endif -#if defined(THREADED_RTS) && defined(NONCONCURRENT_SWEEP) +#if defined(NONCONCURRENT_SWEEP) #if defined(DEBUG) checkNonmovingHeap(&nonmovingHeap); checkSanity(true, true); #endif - nonmoving_write_barrier_enabled = false; - nonmovingFinishFlush(task); + if (concurrent) { + nonmoving_write_barrier_enabled = false; + nonmovingFinishFlush(task); + } #endif // TODO: Remainder of things done by GarbageCollect (update stats) #if defined(THREADED_RTS) finish: - exitMyTask(); + if (concurrent) { + exitMyTask(); - // We are done... - RELAXED_STORE(&mark_thread, 0); - stat_endNonmovingGc(); + // We are done... + RELAXED_STORE(&mark_thread, 0); + stat_endNonmovingGc(); + } // Signal that the concurrent collection is finished, allowing the next // non-moving collection to proceed ===================================== rts/sm/NonMoving.h ===================================== @@ -149,7 +149,8 @@ void nonmovingExit(void); // directly, but in a pause. // void nonmovingCollect(StgWeak **dead_weaks, - StgTSO **resurrected_threads); + StgTSO **resurrected_threads, + bool concurrent); void nonmovingPushFreeSegment(struct NonmovingSegment *seg); ===================================== rts/sm/NonMovingMark.c ===================================== @@ -27,8 +27,10 @@ #include "sm/Storage.h" #include "CNF.h" +#if defined(THREADED_RTS) static void nonmovingResetUpdRemSetQueue (MarkQueue *rset); static void nonmovingResetUpdRemSet (UpdRemSet *rset); +#endif static bool check_in_nonmoving_heap(StgClosure *p); static void mark_closure (MarkQueue *queue, const StgClosure *p, StgClosure **origin); static void trace_tso (MarkQueue *queue, StgTSO *tso); @@ -955,6 +957,7 @@ void nonmovingInitUpdRemSet (UpdRemSet *rset) rset->queue.is_upd_rem_set = true; } +#if defined(THREADED_RTS) static void nonmovingResetUpdRemSetQueue (MarkQueue *rset) { // UpdRemSets always have one block for the mark queue. This assertion is to @@ -968,6 +971,7 @@ void nonmovingResetUpdRemSet (UpdRemSet *rset) { nonmovingResetUpdRemSetQueue(&rset->queue); } +#endif void freeMarkQueue (MarkQueue *queue) { ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -191,6 +191,7 @@ test('T8083', [omit_ways(['ghci']), req_c], compile_and_run, ['T8083_c.c']) test('T9274', [omit_ways(['ghci'])], compile_and_run, ['']) test('ffi023', [ omit_ways(['ghci']), + expect_broken_for(23089, ['threaded2', 'nonmoving_thr', 'nonmoving_thr_sanity', 'nonmoving_thr_ghc']), extra_run_opts('1000 4'), js_broken(22363), pre_cmd('$MAKE -s --no-print-directory ffi023_setup') ], ===================================== testsuite/tests/ffi/should_run/ffi023_c.c ===================================== @@ -4,7 +4,7 @@ HsInt out (HsInt x) { - performMajorGC(); + performBlockingMajorGC(); rts_clearMemory(); return incall(x); } ===================================== testsuite/tests/rts/all.T ===================================== @@ -261,8 +261,8 @@ test('T6006', [ omit_ways(prof_ways + ['ghci']), test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) -test('T7160', [ # finalization order is too nondeterministic in the concurrent GC - omit_ways(['nonmoving_thr', 'nonmoving_thr_ghc', 'nonmoving_thr_sanity']) +test('T7160', [ # finalization order is different in the nonmoving + omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', 'nonmoving_thr_sanity']) , js_broken(22261) ], compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6cb91e16d661f9ef755c5fc399cf90b82368b43b...be9b4ca4da78b10bc065957472ecf2c8ce7599a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6cb91e16d661f9ef755c5fc399cf90b82368b43b...be9b4ca4da78b10bc065957472ecf2c8ce7599a4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 03:54:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 07 Mar 2023 22:54:32 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Fix documentation for traceWith and friends Message-ID: <640806f89cdec_2c78e912f0ff703350e7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - 2b62b65b by David Binder at 2023-03-07T22:53:57-05:00 Remove utils/hpc subdirectory and its contents - - - - - 9a419e34 by David Binder at 2023-03-07T22:53:57-05:00 Add git submodule for utils/hpc - - - - - 6544cdaf by David Binder at 2023-03-07T22:53:57-05:00 Update commit for utils/hpc git submodule - - - - - dfd93620 by David Binder at 2023-03-07T22:53:57-05:00 Update commit for utils/hpc git submodule - - - - - 4cacd042 by Sylvain Henry at 2023-03-07T22:54:08-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 23 changed files: - .gitmodules - libraries/base/Debug/Trace.hs - libraries/base/changelog.md - rts/linker/Elf.c - testsuite/tests/rts/linker/Makefile - + testsuite/tests/rts/linker/T23066.stdout - + testsuite/tests/rts/linker/T23066_c.c - testsuite/tests/rts/linker/all.T - + utils/hpc - − utils/hpc/HpcCombine.hs - − utils/hpc/HpcDraft.hs - − utils/hpc/HpcFlags.hs - − utils/hpc/HpcLexer.hs - − utils/hpc/HpcMarkup.hs - − utils/hpc/HpcOverlay.hs - − utils/hpc/HpcParser.y - − utils/hpc/HpcReport.hs - − utils/hpc/HpcShowTix.hs - − utils/hpc/HpcUtils.hs - − utils/hpc/Main.hs - − utils/hpc/Makefile - − utils/hpc/hpc-bin.cabal - − utils/hpc/hpc.wrapper Changes: ===================================== .gitmodules ===================================== @@ -110,3 +110,6 @@ [submodule "libraries/exceptions"] path = libraries/exceptions url = https://gitlab.haskell.org/ghc/packages/exceptions.git +[submodule "utils/hpc"] + path = utils/hpc + url = https://gitlab.haskell.org/hpc/hpc-bin.git ===================================== libraries/base/Debug/Trace.hs ===================================== @@ -173,7 +173,7 @@ Like 'trace', but outputs the result of calling a function on the argument. hello ("hello","world") - at since 4.17.0.0 + at since 4.18.0.0 -} traceWith :: (a -> String) -> a -> a traceWith f a = trace (f a) a @@ -186,7 +186,7 @@ a 'String'. 3 [1,2,3] - at since 4.17.0.0 + at since 4.18.0.0 -} traceShowWith :: Show b => (a -> b) -> a -> a traceShowWith f = traceWith (show . f) @@ -303,7 +303,7 @@ traceEventIO msg = -- | Like 'traceEvent', but emits the result of calling a function on its -- argument. -- --- @since 4.17.0.0 +-- @since 4.18.0.0 traceEventWith :: (a -> String) -> a -> a traceEventWith f a = traceEvent (f a) a ===================================== libraries/base/changelog.md ===================================== @@ -83,6 +83,9 @@ * `InfoProv` now has additional `ipSrcFile` and `ipSrcSpan` fields. `ipLoc` is now a function computed from these fields. * The `whereFrom` function has been moved + * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to + `Debug.Trace`, per + [CLC proposal #36](https://github.com/haskell/core-libraries-committee/issues/36). ## 4.17.0.0 *August 2022* ===================================== rts/linker/Elf.c ===================================== @@ -872,12 +872,14 @@ ocGetNames_ELF ( ObjectCode* oc ) else if (!oc->imageMapped || size < getPageSize() / 3) { bool executable = kind == SECTIONKIND_CODE_OR_RODATA; m32_allocator *allocator = executable ? oc->rx_m32 : oc->rw_m32; - // align on 16 bytes. The reason being that llvm will emit see - // paddq statements for x86_64 under optimisation and load from - // RODATA sections. Specifically .rodata.cst16. However we don't - // handle the cst part in any way what so ever, so 16 seems - // better than 8. - start = m32_alloc(allocator, size, 16); + // Correctly align the section. This is particularly important for + // the alignment of .rodata.cstNN sections. + // + // llvm will emit see paddq statements for x86_64 under + // optimisation and load from RODATA sections, specifically + // .rodata.cst16. Also we may encounter .rodata.cst32 sections + // in objects using AVX instructions (see #23066). + start = m32_alloc(allocator, size, align); if (start == NULL) goto fail; memcpy(start, oc->image + offset, size); alloc = SECTION_M32; ===================================== testsuite/tests/rts/linker/Makefile ===================================== @@ -12,6 +12,11 @@ section_alignment: '$(TEST_HC)' $(TEST_HC_OPTS_NO_RTSOPTS) -v0 --make -no-rtsopts-suggestions -no-hs-main -o runner runner.c ./runner section_alignment.o isAligned +T23066: + '$(TEST_CC)' $(TEST_CC_OPTS) -c -o T23066_c.o T23066_c.c + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RTSOPTS) -v0 --make -no-rtsopts-suggestions -no-hs-main -o runner runner.c -static + ./runner T23066_c.o isAligned + T2615-prep: $(RM) libfoo_T2615.so '$(TEST_HC)' $(TEST_HC_OPTS) -fPIC -c libfoo_T2615.c -o libfoo_T2615.o ===================================== testsuite/tests/rts/linker/T23066.stdout ===================================== @@ -0,0 +1,2 @@ +Linking: path = T23066_c.o, symname = isAligned +1 ===================================== testsuite/tests/rts/linker/T23066_c.c ===================================== @@ -0,0 +1,42 @@ +#include +#include + +extern int foo32_1, foo32_2; + +// The bug in #23066 was that we wouldn't correctly align 32-bytes aligned +// sections, except by chance (we were always aligning on 16 bytes). +// +// Hence we intersperse two 16-bytes aligned sections with two 32-bytes aligned +// sections to ensure that at least one of the 32-bytes aligned section +// triggers the bug (the order of the sections seems to be preserved). + +__asm__( +" .section pad16_1,\"aM\", at progbits,16\n\t" +" .align 16\n\t" +" .byte 0\n\t" +"\n\t" +" .global foo32_1\n\t" +" .section sfoo32_1,\"aM\", at progbits,32\n\t" +" .align 32\n\t" +"foo32_1:\n\t" +" .byte 0\n\t" +"\n\t" +" .section pad16_2,\"aM\", at progbits,16\n\t" +" .align 16\n\t" +" .byte 0\n\t" +"\n\t" +" .global foo32_2\n\t" +" .section sfoo32_2,\"aM\", at progbits,32\n\t" +" .align 32\n\t" +"foo32_2:\n\t" +" .byte 0\n\t" +); + + +#define ALIGN32(x) (((intptr_t)(&x) & 0x1F) == 0) + +int isAligned() { + //printf("%p\n", &foo32_1); + //printf("%p\n", &foo32_2); + return (ALIGN32(foo32_1) && ALIGN32(foo32_2)); +} ===================================== testsuite/tests/rts/linker/all.T ===================================== @@ -16,6 +16,14 @@ test('section_alignment', ], makefile_test, []) +###################################### +test('T23066', + [ unless(arch('x86_64'), skip) + , unless(opsys('linux'), skip) + , extra_files(['runner.c', 'T23066_c.c']) + ], + makefile_test, []) + ###################################### # Test to see if linker scripts link properly to real ELF files test('T2615', ===================================== utils/hpc ===================================== @@ -0,0 +1 @@ +Subproject commit b376045cb3f3d28815ca29d9c07df2e843cec1c3 ===================================== utils/hpc/HpcCombine.hs deleted ===================================== @@ -1,197 +0,0 @@ ---------------------------------------------------------- --- The main program for the hpc-add tool, part of HPC. --- Andy Gill, Oct 2006 ---------------------------------------------------------- - -module HpcCombine (sum_plugin,combine_plugin,map_plugin) where - -import Trace.Hpc.Tix -import Trace.Hpc.Util - -import HpcFlags - -import Control.Monad -import qualified Data.Set as Set -import qualified Data.Map as Map - ------------------------------------------------------------------------------- -sum_options :: FlagOptSeq -sum_options - = excludeOpt - . includeOpt - . outputOpt - . unionModuleOpt - . verbosityOpt - -sum_plugin :: Plugin -sum_plugin = Plugin { name = "sum" - , usage = "[OPTION] .. [ [ ..]]" - , options = sum_options - , summary = "Sum multiple .tix files in a single .tix file" - , implementation = sum_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -combine_options :: FlagOptSeq -combine_options - = excludeOpt - . includeOpt - . outputOpt - . combineFunOpt - . combineFunOptInfo - . unionModuleOpt - . verbosityOpt - -combine_plugin :: Plugin -combine_plugin = Plugin { name = "combine" - , usage = "[OPTION] .. " - , options = combine_options - , summary = "Combine two .tix files in a single .tix file" - , implementation = combine_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -map_options :: FlagOptSeq -map_options - = excludeOpt - . includeOpt - . outputOpt - . mapFunOpt - . mapFunOptInfo - . unionModuleOpt - . verbosityOpt - -map_plugin :: Plugin -map_plugin = Plugin { name = "map" - , usage = "[OPTION] .. " - , options = map_options - , summary = "Map a function over a single .tix file" - , implementation = map_main - , init_flags = default_flags - , final_flags = default_final_flags - } - ------------------------------------------------------------------------------- - -sum_main :: Flags -> [String] -> IO () -sum_main _ [] = hpcError sum_plugin $ "no .tix file specified" -sum_main flags (first_file:more_files) = do - Just tix <- readTix first_file - - tix' <- foldM (mergeTixFile flags (+)) - (filterTix flags tix) - more_files - - case outputFile flags of - "-" -> putStrLn (show tix') - out -> writeTix out tix' - -combine_main :: Flags -> [String] -> IO () -combine_main flags [first_file,second_file] = do - let f = theCombineFun (combineFun flags) - - Just tix1 <- readTix first_file - Just tix2 <- readTix second_file - - let tix = mergeTix (mergeModule flags) - f - (filterTix flags tix1) - (filterTix flags tix2) - - case outputFile flags of - "-" -> putStrLn (show tix) - out -> writeTix out tix -combine_main _ _ = hpcError combine_plugin $ "need exactly two .tix files to combine" - -map_main :: Flags -> [String] -> IO () -map_main flags [first_file] = do - let f = thePostFun (postFun flags) - - Just tix <- readTix first_file - - let (Tix inside_tix) = filterTix flags tix - let tix' = Tix [ TixModule m p i (map f t) - | TixModule m p i t <- inside_tix - ] - - case outputFile flags of - "-" -> putStrLn (show tix') - out -> writeTix out tix' -map_main _ [] = hpcError map_plugin $ "no .tix file specified" -map_main _ _ = hpcError map_plugin $ "to many .tix files specified" - -mergeTixFile :: Flags -> (Integer -> Integer -> Integer) -> Tix -> String -> IO Tix -mergeTixFile flags fn tix file_name = do - Just new_tix <- readTix file_name - return $! strict $ mergeTix (mergeModule flags) fn tix (filterTix flags new_tix) - --- could allow different numbering on the module info, --- as long as the total is the same; will require normalization. - -mergeTix :: MergeFun - -> (Integer -> Integer -> Integer) -> Tix -> Tix -> Tix -mergeTix modComb f - (Tix t1) - (Tix t2) = Tix - [ case (Map.lookup m fm1,Map.lookup m fm2) of - -- todo, revisit the semantics of this combination - (Just (TixModule _ hash1 len1 tix1),Just (TixModule _ hash2 len2 tix2)) - | hash1 /= hash2 - || length tix1 /= length tix2 - || len1 /= length tix1 - || len2 /= length tix2 - -> error $ "mismatched in module " ++ m - | otherwise -> - TixModule m hash1 len1 (zipWith f tix1 tix2) - (Just m1,Nothing) -> - m1 - (Nothing,Just m2) -> - m2 - _ -> error "impossible" - | m <- Set.toList (theMergeFun modComb m1s m2s) - ] - where - m1s = Set.fromList $ map tixModuleName t1 - m2s = Set.fromList $ map tixModuleName t2 - - fm1 = Map.fromList [ (tixModuleName tix,tix) - | tix <- t1 - ] - fm2 = Map.fromList [ (tixModuleName tix,tix) - | tix <- t2 - ] - - --- What I would give for a hyperstrict :-) --- This makes things about 100 times faster. -class Strict a where - strict :: a -> a - -instance Strict Integer where - strict i = i - -instance Strict Int where - strict i = i - -instance Strict Hash where -- should be fine, because Hash is a newtype round an Int - strict i = i - -instance Strict Char where - strict i = i - -instance Strict a => Strict [a] where - strict (a:as) = (((:) $! strict a) $! strict as) - strict [] = [] - -instance (Strict a, Strict b) => Strict (a,b) where - strict (a,b) = (((,) $! strict a) $! strict b) - -instance Strict Tix where - strict (Tix t1) = - Tix $! strict t1 - -instance Strict TixModule where - strict (TixModule m1 p1 i1 t1) = - ((((TixModule $! strict m1) $! strict p1) $! strict i1) $! strict t1) ===================================== utils/hpc/HpcDraft.hs deleted ===================================== @@ -1,144 +0,0 @@ -module HpcDraft (draft_plugin) where - -import Trace.Hpc.Tix -import Trace.Hpc.Mix -import Trace.Hpc.Util - -import HpcFlags - -import qualified Data.Set as Set -import qualified Data.Map as Map -import HpcUtils -import Data.Tree - ------------------------------------------------------------------------------- -draft_options :: FlagOptSeq -draft_options - = excludeOpt - . includeOpt - . srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . outputOpt - . verbosityOpt - -draft_plugin :: Plugin -draft_plugin = Plugin { name = "draft" - , usage = "[OPTION] .. " - , options = draft_options - , summary = "Generate draft overlay that provides 100% coverage" - , implementation = draft_main - , init_flags = default_flags - , final_flags = default_final_flags - } - ------------------------------------------------------------------------------- - -draft_main :: Flags -> [String] -> IO () -draft_main _ [] = error "draft_main: unhandled case: []" -draft_main hpcflags (progName:mods) = do - let hpcflags1 = hpcflags - { includeMods = Set.fromList mods - `Set.union` - includeMods hpcflags } - let prog = getTixFileName $ progName - tix <- readTix prog - case tix of - Just (Tix tickCounts) -> do - outs <- sequence - [ makeDraft hpcflags1 tixModule - | tixModule@(TixModule m _ _ _) <- tickCounts - , allowModule hpcflags1 m - ] - case outputFile hpcflags1 of - "-" -> putStrLn (unlines outs) - out -> writeFile out (unlines outs) - Nothing -> hpcError draft_plugin $ "unable to find tix file for:" ++ progName - - -makeDraft :: Flags -> TixModule -> IO String -makeDraft hpcflags tix = do - let modu = tixModuleName tix - tixs = tixModuleTixs tix - - (Mix filepath _ _ _ entries) <- readMixWithFlags hpcflags (Right tix) - - let forest = createMixEntryDom - [ (srcspan,(box,v > 0)) - | ((srcspan,box),v) <- zip entries tixs - ] - --- let show' (span,stuff) = show (span,stuff,grabHpcPos hsMap span) --- putStrLn $ drawForest $ map (fmap show) $ forest - - let non_ticked = findNotTickedFromList forest - - hs <- readFileFromPath (hpcError draft_plugin) filepath (srcDirs hpcflags) - - let hsMap :: Map.Map Int String - hsMap = Map.fromList (zip [1..] $ lines hs) - - let quoteString = show - - let firstLine pos = case fromHpcPos pos of - (ln,_,_,_) -> ln - - - let showPleaseTick :: Int -> PleaseTick -> String - showPleaseTick d (TickFun str pos) = - spaces d ++ "tick function \"" ++ last str ++ "\" " - ++ "on line " ++ show (firstLine pos) ++ ";" - showPleaseTick d (TickExp pos) = - spaces d ++ "tick " - ++ if '\n' `elem` txt - then "at position " ++ show pos ++ ";" - else quoteString txt ++ " " ++ "on line " ++ show (firstLine pos) ++ ";" - - where - txt = grabHpcPos hsMap pos - - showPleaseTick d (TickInside [str] _ pleases) = - spaces d ++ "inside \"" ++ str ++ "\" {\n" ++ - showPleaseTicks (d + 2) pleases ++ - spaces d ++ "}" - - showPleaseTick _ (TickInside _ _ _) - = error "showPleaseTick: Unhandled case TickInside" - - showPleaseTicks d pleases = unlines (map (showPleaseTick d) pleases) - - spaces d = take d (repeat ' ') - - return $ "module " ++ show (fixPackageSuffix modu) ++ " {\n" ++ - showPleaseTicks 2 non_ticked ++ "}" - -fixPackageSuffix :: String -> String -fixPackageSuffix modu = case span (/= '/') modu of - (before,'/':after) -> before ++ ":" ++ after - _ -> modu - -data PleaseTick - = TickFun [String] HpcPos - | TickExp HpcPos - | TickInside [String] HpcPos [PleaseTick] - deriving Show - -mkTickInside :: [String] -> HpcPos -> [PleaseTick] - -> [PleaseTick] -> [PleaseTick] -mkTickInside _ _ [] = id -mkTickInside nm pos inside = (TickInside nm pos inside :) - -findNotTickedFromTree :: MixEntryDom [(BoxLabel,Bool)] -> [PleaseTick] -findNotTickedFromTree (Node (pos,(ExpBox {},False):_) _) = [TickExp pos] -findNotTickedFromTree (Node (pos,(TopLevelBox nm,False):_) _) - = [ TickFun nm pos ] -findNotTickedFromTree (Node (pos,(LocalBox nm,False):_) _) - = [ TickFun nm pos ] -findNotTickedFromTree (Node (pos,(TopLevelBox nm,True):_) children) - = mkTickInside nm pos (findNotTickedFromList children) [] -findNotTickedFromTree (Node (pos,_:others) children) = - findNotTickedFromTree (Node (pos,others) children) -findNotTickedFromTree (Node (_, []) children) = findNotTickedFromList children - -findNotTickedFromList :: [MixEntryDom [(BoxLabel,Bool)]] -> [PleaseTick] -findNotTickedFromList = concatMap findNotTickedFromTree ===================================== utils/hpc/HpcFlags.hs deleted ===================================== @@ -1,268 +0,0 @@ --- (c) 2007 Andy Gill - -module HpcFlags where - -import System.Console.GetOpt -import qualified Data.Set as Set -import Data.Char -import Trace.Hpc.Tix -import Trace.Hpc.Mix -import System.Exit -import System.FilePath - -data Flags = Flags - { outputFile :: String - , includeMods :: Set.Set String - , excludeMods :: Set.Set String - , hpcDirs :: [String] - , srcDirs :: [String] - , destDir :: String - - , perModule :: Bool - , decList :: Bool - , xmlOutput :: Bool - - , funTotals :: Bool - , altHighlight :: Bool - - , combineFun :: CombineFun -- tick-wise combine - , postFun :: PostFun -- - , mergeModule :: MergeFun -- module-wise merge - - , verbosity :: Verbosity - } - -default_flags :: Flags -default_flags = Flags - { outputFile = "-" - , includeMods = Set.empty - , excludeMods = Set.empty - , hpcDirs = [".hpc"] - , srcDirs = [] - , destDir = "." - - , perModule = False - , decList = False - , xmlOutput = False - - , funTotals = False - , altHighlight = False - - , combineFun = ADD - , postFun = ID - , mergeModule = INTERSECTION - - , verbosity = Normal - } - - -data Verbosity = Silent | Normal | Verbose - deriving (Eq, Ord) - -verbosityFromString :: String -> Verbosity -verbosityFromString "0" = Silent -verbosityFromString "1" = Normal -verbosityFromString "2" = Verbose -verbosityFromString v = error $ "unknown verbosity: " ++ v - - --- We do this after reading flags, because the defaults --- depends on if specific flags we used. - -default_final_flags :: Flags -> Flags -default_final_flags flags = flags - { srcDirs = if null (srcDirs flags) - then ["."] - else srcDirs flags - } - -type FlagOptSeq = [OptDescr (Flags -> Flags)] -> [OptDescr (Flags -> Flags)] - -noArg :: String -> String -> (Flags -> Flags) -> FlagOptSeq -noArg flag detail fn = (:) $ Option [] [flag] (NoArg $ fn) detail - -anArg :: String -> String -> String -> (String -> Flags -> Flags) -> FlagOptSeq -anArg flag detail argtype fn = (:) $ Option [] [flag] (ReqArg fn argtype) detail - -infoArg :: String -> FlagOptSeq -infoArg info = (:) $ Option [] [] (NoArg $ id) info - -excludeOpt, includeOpt, hpcDirOpt, resetHpcDirsOpt, srcDirOpt, - destDirOpt, outputOpt, verbosityOpt, - perModuleOpt, decListOpt, xmlOutputOpt, funTotalsOpt, - altHighlightOpt, combineFunOpt, combineFunOptInfo, mapFunOpt, - mapFunOptInfo, unionModuleOpt :: FlagOptSeq -excludeOpt = anArg "exclude" "exclude MODULE and/or PACKAGE" "[PACKAGE:][MODULE]" - $ \ a f -> f { excludeMods = a `Set.insert` excludeMods f } - -includeOpt = anArg "include" "include MODULE and/or PACKAGE" "[PACKAGE:][MODULE]" - $ \ a f -> f { includeMods = a `Set.insert` includeMods f } - -hpcDirOpt = anArg "hpcdir" "append sub-directory that contains .mix files" "DIR" - (\ a f -> f { hpcDirs = hpcDirs f ++ [a] }) - . infoArg "default .hpc [rarely used]" - -resetHpcDirsOpt = noArg "reset-hpcdirs" "empty the list of hpcdir's" - (\ f -> f { hpcDirs = [] }) - . infoArg "[rarely used]" - -srcDirOpt = anArg "srcdir" "path to source directory of .hs files" "DIR" - (\ a f -> f { srcDirs = srcDirs f ++ [a] }) - . infoArg "multi-use of srcdir possible" - -destDirOpt = anArg "destdir" "path to write output to" "DIR" - $ \ a f -> f { destDir = a } - - -outputOpt = anArg "output" "output FILE" "FILE" $ \ a f -> f { outputFile = a } - -verbosityOpt = anArg "verbosity" "verbosity level, 0-2" "[0-2]" - (\ a f -> f { verbosity = verbosityFromString a }) - . infoArg "default 1" - --- markup - -perModuleOpt = noArg "per-module" "show module level detail" $ \ f -> f { perModule = True } -decListOpt = noArg "decl-list" "show unused decls" $ \ f -> f { decList = True } -xmlOutputOpt = noArg "xml-output" "show output in XML" $ \ f -> f { xmlOutput = True } -funTotalsOpt = noArg "fun-entry-count" "show top-level function entry counts" - $ \ f -> f { funTotals = True } -altHighlightOpt - = noArg "highlight-covered" "highlight covered code, rather that code gaps" - $ \ f -> f { altHighlight = True } - -combineFunOpt = anArg "function" - "combine .tix files with join function, default = ADD" "FUNCTION" - $ \ a f -> case reads (map toUpper a) of - [(c,"")] -> f { combineFun = c } - _ -> error $ "no such combine function : " ++ a -combineFunOptInfo = infoArg - $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst foldFuns) - -mapFunOpt = anArg "function" - "apply function to .tix files, default = ID" "FUNCTION" - $ \ a f -> case reads (map toUpper a) of - [(c,"")] -> f { postFun = c } - _ -> error $ "no such combine function : " ++ a -mapFunOptInfo = infoArg - $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst postFuns) - -unionModuleOpt = noArg "union" - "use the union of the module namespace (default is intersection)" - $ \ f -> f { mergeModule = UNION } - - -------------------------------------------------------------------------------- - -readMixWithFlags :: Flags -> Either String TixModule -> IO Mix -readMixWithFlags flags modu = readMix [ dir hpcDir - | dir <- srcDirs flags - , hpcDir <- hpcDirs flags - ] modu - -------------------------------------------------------------------------------- - -command_usage :: Plugin -> IO () -command_usage plugin = - putStrLn $ - "Usage: hpc " ++ (name plugin) ++ " " ++ - (usage plugin) ++ - "\n" ++ summary plugin ++ "\n" ++ - if null (options plugin []) - then "" - else usageInfo "\n\nOptions:\n" (options plugin []) - -hpcError :: Plugin -> String -> IO a -hpcError plugin msg = do - putStrLn $ "Error: " ++ msg - command_usage plugin - exitFailure - -------------------------------------------------------------------------------- - -data Plugin = Plugin { name :: String - , usage :: String - , options :: FlagOptSeq - , summary :: String - , implementation :: Flags -> [String] -> IO () - , init_flags :: Flags - , final_flags :: Flags -> Flags - } - ------------------------------------------------------------------------------- - --- filterModules takes a list of candidate modules, --- and --- * excludes the excluded modules --- * includes the rest if there are no explicitly included modules --- * otherwise, accepts just the included modules. - -allowModule :: Flags -> String -> Bool -allowModule flags full_mod - | full_mod' `Set.member` excludeMods flags = False - | pkg_name `Set.member` excludeMods flags = False - | mod_name `Set.member` excludeMods flags = False - | Set.null (includeMods flags) = True - | full_mod' `Set.member` includeMods flags = True - | pkg_name `Set.member` includeMods flags = True - | mod_name `Set.member` includeMods flags = True - | otherwise = False - where - full_mod' = pkg_name ++ mod_name - -- pkg name always ends with '/', main - (pkg_name,mod_name) = - case span (/= '/') full_mod of - (p,'/':m) -> (p ++ ":",m) - (m,[]) -> (":",m) - _ -> error "impossible case in allowModule" - -filterTix :: Flags -> Tix -> Tix -filterTix flags (Tix tixs) = - Tix $ filter (allowModule flags . tixModuleName) tixs - - - ------------------------------------------------------------------------------- --- HpcCombine specifics - -data CombineFun = ADD | DIFF | SUB - deriving (Eq,Show, Read, Enum) - -theCombineFun :: CombineFun -> Integer -> Integer -> Integer -theCombineFun fn = case fn of - ADD -> \ l r -> l + r - SUB -> \ l r -> max 0 (l - r) - DIFF -> \ g b -> if g > 0 then 0 else min 1 b - -foldFuns :: [ (String,CombineFun) ] -foldFuns = [ (show comb,comb) - | comb <- [ADD .. SUB] - ] - -data PostFun = ID | INV | ZERO - deriving (Eq,Show, Read, Enum) - -thePostFun :: PostFun -> Integer -> Integer -thePostFun ID x = x -thePostFun INV 0 = 1 -thePostFun INV _ = 0 -thePostFun ZERO _ = 0 - -postFuns :: [(String, PostFun)] -postFuns = [ (show pos,pos) - | pos <- [ID .. ZERO] - ] - - -data MergeFun = INTERSECTION | UNION - deriving (Eq,Show, Read, Enum) - -theMergeFun :: (Ord a) => MergeFun -> Set.Set a -> Set.Set a -> Set.Set a -theMergeFun INTERSECTION = Set.intersection -theMergeFun UNION = Set.union - -mergeFuns :: [(String, MergeFun)] -mergeFuns = [ (show pos,pos) - | pos <- [INTERSECTION,UNION] - ] - ===================================== utils/hpc/HpcLexer.hs deleted ===================================== @@ -1,57 +0,0 @@ -module HpcLexer where - -import Data.Char - -data Token - = ID String - | SYM Char - | INT Int - | STR String - | CAT String - deriving (Eq,Show) - -initLexer :: String -> [Token] -initLexer str = [ t | (_,_,t) <- lexer str 1 1 ] - -lexer :: String -> Int -> Int -> [(Int,Int,Token)] -lexer (c:cs) line column - | c == '\n' = lexer cs (succ line) 1 - | c == '\"' = lexerSTR cs line (succ column) - | c == '[' = lexerCAT cs "" line (succ column) - | c `elem` "{};-:" - = (line,column,SYM c) : lexer cs line (succ column) - | isSpace c = lexer cs line (succ column) - | isAlpha c = lexerKW cs [c] line (succ column) - | isDigit c = lexerINT cs [c] line (succ column) - | otherwise = error "lexer failure" -lexer [] _ _ = [] - -lexerKW :: String -> String -> Int -> Int -> [(Int,Int,Token)] -lexerKW (c:cs) s line column - | isAlpha c = lexerKW cs (s ++ [c]) line (succ column) -lexerKW other s line column = (line,column,ID s) : lexer other line column - -lexerINT :: String -> String -> Int -> Int -> [(Int,Int,Token)] -lexerINT (c:cs) s line column - | isDigit c = lexerINT cs (s ++ [c]) line (succ column) -lexerINT other s line column = (line,column,INT (read s)) : lexer other line column - --- not technically correct for the new column count, but a good approximation. -lexerSTR :: String -> Int -> Int -> [(Int,Int,Token)] -lexerSTR cs line column - = case lex ('"' : cs) of - [(str,rest)] -> (line,succ column,STR (read str)) - : lexer rest line (length (show str) + column + 1) - _ -> error "bad string" - -lexerCAT :: String -> String -> Int -> Int -> [(Int,Int,Token)] -lexerCAT (c:cs) s line column - | c == ']' = (line,column,CAT s) : lexer cs line (succ column) - | otherwise = lexerCAT cs (s ++ [c]) line (succ column) -lexerCAT [] _ _ _ = error "lexer failure in CAT" - -test :: IO () -test = do - t <- readFile "EXAMPLE.tc" - print (initLexer t) - ===================================== utils/hpc/HpcMarkup.hs deleted ===================================== @@ -1,485 +0,0 @@ ---------------------------------------------------------- --- The main program for the hpc-markup tool, part of HPC. --- Andy Gill and Colin Runciman, June 2006 ---------------------------------------------------------- - -module HpcMarkup (markup_plugin) where - -import Trace.Hpc.Mix -import Trace.Hpc.Tix -import Trace.Hpc.Util (HpcPos, fromHpcPos, writeFileUtf8) - -import HpcFlags -import HpcUtils - -import System.FilePath -import Data.List (sortBy, find) -import Data.Maybe(fromJust) -import Data.Semigroup as Semi -import Data.Array -import Control.Monad -import qualified Data.Set as Set - ------------------------------------------------------------------------------- - -markup_options :: FlagOptSeq -markup_options - = excludeOpt - . includeOpt - . srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . funTotalsOpt - . altHighlightOpt - . destDirOpt - . verbosityOpt - -markup_plugin :: Plugin -markup_plugin = Plugin { name = "markup" - , usage = "[OPTION] .. [ [ ..]]" - , options = markup_options - , summary = "Markup Haskell source with program coverage" - , implementation = markup_main - , init_flags = default_flags - , final_flags = default_final_flags - } - ------------------------------------------------------------------------------- - -markup_main :: Flags -> [String] -> IO () -markup_main flags (prog:modNames) = do - let hpcflags1 = flags - { includeMods = Set.fromList modNames - `Set.union` - includeMods flags } - let Flags - { funTotals = theFunTotals - , altHighlight = invertOutput - , destDir = dest_dir - } = hpcflags1 - - mtix <- readTix (getTixFileName prog) - Tix tixs <- case mtix of - Nothing -> hpcError markup_plugin $ "unable to find tix file for: " ++ prog - Just a -> return a - - mods <- - sequence [ genHtmlFromMod dest_dir hpcflags1 tix theFunTotals invertOutput - | tix <- tixs - , allowModule hpcflags1 (tixModuleName tix) - ] - - let index_name = "hpc_index" - index_fun = "hpc_index_fun" - index_alt = "hpc_index_alt" - index_exp = "hpc_index_exp" - - let writeSummary filename cmp = do - let mods' = sortBy cmp mods - - unless (verbosity flags < Normal) $ - putStrLn $ "Writing: " ++ (filename <.> "html") - - writeFileUtf8 (dest_dir filename <.> "html") $ - "" ++ - "" ++ - "" ++ - "\n" ++ - "" ++ - "" ++ - "\n" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - concat [ showModuleSummary (modName,fileName,modSummary) - | (modName,fileName,modSummary) <- mods' - ] ++ - "" ++ - showTotalSummary (mconcat - [ modSummary - | (_,_,modSummary) <- mods' - ]) - ++ "
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
\n" - - writeSummary index_name $ \ (n1,_,_) (n2,_,_) -> compare n1 n2 - - writeSummary index_fun $ \ (_,_,s1) (_,_,s2) -> - compare (percent (topFunTicked s2) (topFunTotal s2)) - (percent (topFunTicked s1) (topFunTotal s1)) - - writeSummary index_alt $ \ (_,_,s1) (_,_,s2) -> - compare (percent (altTicked s2) (altTotal s2)) - (percent (altTicked s1) (altTotal s1)) - - writeSummary index_exp $ \ (_,_,s1) (_,_,s2) -> - compare (percent (expTicked s2) (expTotal s2)) - (percent (expTicked s1) (expTotal s1)) - - -markup_main _ [] - = hpcError markup_plugin $ "no .tix file or executable name specified" - --- Add characters to the left of a string until it is at least as --- large as requested. -padLeft :: Int -> Char -> String -> String -padLeft n c str = go n str - where - -- If the string is already long enough, stop traversing it. - go 0 _ = str - go k [] = replicate k c ++ str - go k (_:xs) = go (k-1) xs - -genHtmlFromMod - :: String - -> Flags - -> TixModule - -> Bool - -> Bool - -> IO (String, [Char], ModuleSummary) -genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do - let theHsPath = srcDirs flags - let modName0 = tixModuleName tix - - (Mix origFile _ _ tabStop mix') <- readMixWithFlags flags (Right tix) - - let arr_tix :: Array Int Integer - arr_tix = listArray (0,length (tixModuleTixs tix) - 1) - $ tixModuleTixs tix - - let tickedWith :: Int -> Integer - tickedWith n = arr_tix ! n - - isTicked n = tickedWith n /= 0 - - let info = [ (pos,theMarkup) - | (gid,(pos,boxLabel)) <- zip [0 ..] mix' - , let binBox = case (isTicked gid,isTicked (gid+1)) of - (False,False) -> [] - (True,False) -> [TickedOnlyTrue] - (False,True) -> [TickedOnlyFalse] - (True,True) -> [] - , let tickBox = if isTicked gid - then [IsTicked] - else [NotTicked] - , theMarkup <- case boxLabel of - ExpBox {} -> tickBox - TopLevelBox {} - -> TopLevelDecl theFunTotals (tickedWith gid) : tickBox - LocalBox {} -> tickBox - BinBox _ True -> binBox - _ -> [] - ] - - - let modSummary = foldr (.) id - [ \ st -> - case boxLabel of - ExpBox False - -> st { expTicked = ticked (expTicked st) - , expTotal = succ (expTotal st) - } - ExpBox True - -> st { expTicked = ticked (expTicked st) - , expTotal = succ (expTotal st) - , altTicked = ticked (altTicked st) - , altTotal = succ (altTotal st) - } - TopLevelBox _ -> - st { topFunTicked = ticked (topFunTicked st) - , topFunTotal = succ (topFunTotal st) - } - _ -> st - | (gid,(_pos,boxLabel)) <- zip [0 ..] mix' - , let ticked = if isTicked gid - then succ - else id - ] $ mempty - - -- add prefix to modName argument - content <- readFileFromPath (hpcError markup_plugin) origFile theHsPath - - let content' = markup tabStop info content - let addLine n xs = "" ++ padLeft 5 ' ' (show n) ++ " " ++ xs - let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines - let fileName = modName0 <.> "hs" <.> "html" - unless (verbosity flags < Normal) $ - putStrLn $ "Writing: " ++ fileName - writeFileUtf8 (dest_dir fileName) $ - unlines ["", - "", - "", - "", - "", - "", - "
",
-                     concat [
-                         "",
-                         "never executed ",
-                         "always true ",
-                         "always false"],
-                     "
", - "
"] ++ addLines content' ++ "\n
\n\n\n"; - - - modSummary `seq` return (modName0,fileName,modSummary) - -data Loc = Loc !Int !Int - deriving (Eq,Ord,Show) - -data Markup - = NotTicked - | TickedOnlyTrue - | TickedOnlyFalse - | IsTicked - | TopLevelDecl - Bool -- display entry totals - Integer - deriving (Eq,Show) - -markup :: Int -- ^tabStop - -> [(HpcPos,Markup)] -- random list of tick location pairs - -> String -- text to mark up - -> String -markup tabStop mix str = addMarkup tabStop str (Loc 1 1) [] sortedTickLocs - where - tickLocs = [ (Loc ln1 c1,Loc ln2 c2,mark) - | (pos,mark) <- mix - , let (ln1,c1,ln2,c2) = fromHpcPos pos - ] - sortedTickLocs = sortBy (\(locA1,locZ1,_) (locA2,locZ2,_) -> - (locA1,locZ2) `compare` (locA2,locZ1)) tickLocs - -addMarkup :: Int -- tabStop - -> String -- text to mark up - -> Loc -- current location - -> [(Loc,Markup)] -- stack of open ticks, with closing location - -> [(Loc,Loc,Markup)] -- sorted list of tick location pairs - -> String - --- check the pre-condition. ---addMarkup tabStop cs loc os ticks --- | not (isSorted (map fst os)) = error $ "addMarkup: bad closing ordering: " ++ show os - ---addMarkup tabStop cs loc os@(_:_) ticks --- | trace (show (loc,os,take 10 ticks)) False = undefined - --- close all open ticks, if we have reached the end -addMarkup _ [] _loc os [] = - concatMap (const closeTick) os -addMarkup tabStop cs loc ((o,_):os) ticks | loc > o = - closeTick ++ addMarkup tabStop cs loc os ticks - ---addMarkup tabStop cs loc os ((t1,t2,tik@(TopLevelDecl {})):ticks) | loc == t1 = --- openTick tik ++ closeTick ++ addMarkup tabStop cs loc os ticks - -addMarkup tabStop cs loc os ((t1,t2,tik0):ticks) | loc == t1 = - case os of - ((_,tik'):_) - | not (allowNesting tik0 tik') - -> addMarkup tabStop cs loc os ticks -- already marked or bool within marked bool - _ -> openTick tik0 ++ addMarkup tabStop cs loc (addTo (t2,tik0) os) ticks - where - - addTo (t,tik) [] = [(t,tik)] - addTo (t,tik) ((t',tik'):xs) | t <= t' = (t,tik):(t',tik'):xs - | otherwise = (t',tik):(t',tik'):xs - -addMarkup tabStop0 cs loc os ((t1,_t2,_tik):ticks) | loc > t1 = - -- throw away this tick, because it is from a previous place ?? - addMarkup tabStop0 cs loc os ticks - -addMarkup tabStop0 ('\n':cs) loc@(Loc ln col) os@((Loc ln2 col2,_):_) ticks - | ln == ln2 && col < col2 - = addMarkup tabStop0 (' ':'\n':cs) loc os ticks -addMarkup tabStop0 (c0:cs) loc@(Loc _ p) os ticks = - if c0=='\n' && os/=[] then - concatMap (const closeTick) (downToTopLevel os) ++ - c0 : "" ++ expand 1 w ++ "" ++ - concatMap (openTick.snd) (reverse (downToTopLevel os)) ++ - addMarkup tabStop0 cs' loc' os ticks - else if c0=='\t' then - expand p "\t" ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks - else - escape c0 ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks - where - (w,cs') = span (`elem` " \t") cs - loc' = foldl (flip incBy) loc (c0:w) - escape '>' = ">" - escape '<' = "<" - escape '"' = """ - escape '&' = "&" - escape c = [c] - - expand :: Int -> String -> String - expand _ "" = "" - expand c ('\t':s) = replicate (c' - c) ' ' ++ expand c' s - where - c' = tabStopAfter 8 c - expand c (' ':s) = ' ' : expand (c+1) s - expand _ _ = error "bad character in string for expansion" - - incBy :: Char -> Loc -> Loc - incBy '\n' (Loc ln _c) = Loc (succ ln) 1 - incBy '\t' (Loc ln c) = Loc ln (tabStopAfter tabStop0 c) - incBy _ (Loc ln c) = Loc ln (succ c) - - tabStopAfter :: Int -> Int -> Int - tabStopAfter tabStop c = fromJust (find (>c) [1,(tabStop + 1)..]) - - -addMarkup tabStop cs loc os ticks = "ERROR: " ++ show (take 10 cs,tabStop,loc,take 10 os,take 10 ticks) - -openTick :: Markup -> String -openTick NotTicked = "" -openTick IsTicked = "" -openTick TickedOnlyTrue = "" -openTick TickedOnlyFalse = "" -openTick (TopLevelDecl False _) = openTopDecl -openTick (TopLevelDecl True 0) - = "-- never entered" ++ - openTopDecl -openTick (TopLevelDecl True 1) - = "-- entered once" ++ - openTopDecl -openTick (TopLevelDecl True n0) - = "-- entered " ++ showBigNum n0 ++ " times" ++ openTopDecl - where showBigNum n | n <= 9999 = show n - | otherwise = case n `quotRem` 1000 of - (q, r) -> showBigNum' q ++ "," ++ showWith r - showBigNum' n | n <= 999 = show n - | otherwise = case n `quotRem` 1000 of - (q, r) -> showBigNum' q ++ "," ++ showWith r - showWith n = padLeft 3 '0' $ show n - - - -closeTick :: String -closeTick = "" - -openTopDecl :: String -openTopDecl = "" - -downToTopLevel :: [(Loc,Markup)] -> [(Loc,Markup)] -downToTopLevel ((_,TopLevelDecl {}):_) = [] -downToTopLevel (o : os) = o : downToTopLevel os -downToTopLevel [] = [] - - --- build in logic for nesting bin boxes - -allowNesting :: Markup -- innermost - -> Markup -- outermost - -> Bool -allowNesting n m | n == m = False -- no need to double nest -allowNesting IsTicked TickedOnlyFalse = False -allowNesting IsTicked TickedOnlyTrue = False -allowNesting _ _ = True - ------------------------------------------------------------------------------- - -data ModuleSummary = ModuleSummary - { expTicked :: !Int - , expTotal :: !Int - , topFunTicked :: !Int - , topFunTotal :: !Int - , altTicked :: !Int - , altTotal :: !Int - } - deriving (Show) - - -showModuleSummary :: (String, String, ModuleSummary) -> String -showModuleSummary (modName,fileName,modSummary) = - "\n" ++ - "  module " - ++ modName ++ "\n" ++ - showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++ - showSummary (altTicked modSummary) (altTotal modSummary) ++ - showSummary (expTicked modSummary) (expTotal modSummary) ++ - "\n" - -showTotalSummary :: ModuleSummary -> String -showTotalSummary modSummary = - "\n" ++ - "  Program Coverage Total\n" ++ - showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++ - showSummary (altTicked modSummary) (altTotal modSummary) ++ - showSummary (expTicked modSummary) (expTotal modSummary) ++ - "\n" - -showSummary :: (Integral t, Show t) => t -> t -> String -showSummary ticked total = - "" ++ showP (percent ticked total) ++ "" ++ - "" ++ show ticked ++ "/" ++ show total ++ "" ++ - "" ++ - (case percent ticked total of - Nothing -> " " - Just w -> bar w "bar" - ) ++ "" - where - showP Nothing = "- " - showP (Just x) = show x ++ "%" - bar 0 _ = bar 100 "invbar" - bar w inner = "" ++ - "
" ++ - "" ++ - "
" - -percent :: (Integral a) => a -> a -> Maybe a -percent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` total) - -instance Semi.Semigroup ModuleSummary where - (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1) <> (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2) - = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2) - -instance Monoid ModuleSummary where - mempty = ModuleSummary - { expTicked = 0 - , expTotal = 0 - , topFunTicked = 0 - , topFunTotal = 0 - , altTicked = 0 - , altTotal = 0 - } - mappend = (<>) - ------------------------------------------------------------------------------- --- global color palette - -red,green,yellow :: String -red = "#f20913" -green = "#60de51" -yellow = "yellow" ===================================== utils/hpc/HpcOverlay.hs deleted ===================================== @@ -1,157 +0,0 @@ -module HpcOverlay where - -import HpcFlags -import HpcParser -import HpcUtils -import Trace.Hpc.Tix -import Trace.Hpc.Mix -import Trace.Hpc.Util -import qualified Data.Map as Map -import Data.Tree - -overlay_options :: FlagOptSeq -overlay_options - = srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . outputOpt - . verbosityOpt - -overlay_plugin :: Plugin -overlay_plugin = Plugin { name = "overlay" - , usage = "[OPTION] .. [ [...]]" - , options = overlay_options - , summary = "Generate a .tix file from an overlay file" - , implementation = overlay_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -overlay_main :: Flags -> [String] -> IO () -overlay_main _ [] = hpcError overlay_plugin $ "no overlay file specified" -overlay_main flags files = do - specs <- mapM hpcParser files - let (Spec globals modules) = concatSpec specs - - let modules1 = Map.fromListWith (++) [ (m,info) | (m,info) <- modules ] - - mod_info <- - sequence [ do mix@(Mix origFile _ _ _ _) <- readMixWithFlags flags (Left modu) - content <- readFileFromPath (hpcError overlay_plugin) origFile (srcDirs flags) - processModule modu content mix mod_spec globals - | (modu, mod_spec) <- Map.toList modules1 - ] - - - let tix = Tix $ mod_info - - case outputFile flags of - "-" -> putStrLn (show tix) - out -> writeFile out (show tix) - - -processModule :: String -- ^ module name - -> String -- ^ module contents - -> Mix -- ^ mix entry for this module - -> [Tick] -- ^ local ticks - -> [ExprTick] -- ^ global ticks - -> IO TixModule -processModule modName modContents (Mix _ _ hash _ entries) locals globals = do - - let hsMap :: Map.Map Int String - hsMap = Map.fromList (zip [1..] $ lines modContents) - - let topLevelFunctions = - Map.fromListWith (++) - [ (nm,[pos]) - | (pos,TopLevelBox [nm]) <- entries - ] - - let inside :: HpcPos -> String -> Bool - inside pos nm = - case Map.lookup nm topLevelFunctions of - Nothing -> False - Just poss -> any (pos `insideHpcPos`) poss - - -- TODO: rename plzTick => plzExprTick, plzTopPick => plzTick - let plzTick :: HpcPos -> BoxLabel -> ExprTick -> Bool - plzTick pos (ExpBox _) (TickExpression _ match q _) = - qualifier pos q - && case match of - Nothing -> True - Just str -> str == grabHpcPos hsMap pos - plzTick _ _ _ = False - - - plzTopTick :: HpcPos -> BoxLabel -> Tick -> Bool - plzTopTick pos label (ExprTick ignore) = plzTick pos label ignore - plzTopTick pos _ (TickFunction fn q _) = - qualifier pos q && pos `inside` fn - plzTopTick pos label (InsideFunction fn igs) = - pos `inside` fn && any (plzTopTick pos label) igs - - - let tixs = Map.fromList - [ (ix, - any (plzTick pos label) globals - || any (plzTopTick pos label) locals) - | (ix,(pos,label)) <- zip [0..] entries - ] - - - -- let show' (srcspan,stuff) = show (srcspan,stuff,grabHpcPos hsMap span) - - let forest = createMixEntryDom - [ (srcspan,ix) - | ((srcspan,_),ix) <- zip entries [0..] - ] - - - -- - let forest2 = addParentToList [] $ forest --- putStrLn $ drawForest $ map (fmap show') $ forest2 - - let isDomList = Map.fromList - [ (ix,filter (/= ix) rng ++ dom) - | (_,(rng,dom)) <- concatMap flatten forest2 - , ix <- rng - ] - - -- We do not use laziness here, because the dominator lists - -- point to their equivent peers, creating loops. - - - let isTicked n = - case Map.lookup n tixs of - Just v -> v - Nothing -> error $ "can not find ix # " ++ show n - - let tixs' = [ case Map.lookup n isDomList of - Just vs -> if any isTicked (n : vs) then 1 else 0 - Nothing -> error $ "can not find ix in dom list # " ++ show n - | n <- [0..(length entries - 1)] - ] - - return $ TixModule modName hash (length tixs') tixs' - -qualifier :: HpcPos -> Maybe Qualifier -> Bool -qualifier _ Nothing = True -qualifier pos (Just (OnLine n)) = n == l1 && n == l2 - where (l1,_,l2,_) = fromHpcPos pos -qualifier pos (Just (AtPosition l1' c1' l2' c2')) - = (l1', c1', l2', c2') == fromHpcPos pos - -concatSpec :: [Spec] -> Spec -concatSpec = foldr - (\ (Spec pre1 body1) (Spec pre2 body2) - -> Spec (pre1 ++ pre2) (body1 ++ body2)) - (Spec [] []) - - - -addParentToTree :: [a] -> MixEntryDom [a] -> MixEntryDom ([a],[a]) -addParentToTree path (Node (pos,a) children) = - Node (pos,(a,path)) (addParentToList (a ++ path) children) - -addParentToList :: [a] -> [MixEntryDom [a]] -> [MixEntryDom ([a],[a])] -addParentToList path nodes = map (addParentToTree path) nodes ===================================== utils/hpc/HpcParser.y deleted ===================================== @@ -1,106 +0,0 @@ -{ -module HpcParser where - -import HpcLexer -} - -%name parser -%expect 0 -%tokentype { Token } - -%token - MODULE { ID "module" } - TICK { ID "tick" } - EXPRESSION { ID "expression" } - ON { ID "on" } - LINE { ID "line" } - POSITION { ID "position" } - FUNCTION { ID "function" } - INSIDE { ID "inside" } - AT { ID "at" } - ':' { SYM ':' } - '-' { SYM '-' } - ';' { SYM ';' } - '{' { SYM '{' } - '}' { SYM '}' } - int { INT $$ } - string { STR $$ } - cat { CAT $$ } -%% - -Spec :: { Spec } -Spec : Ticks Modules { Spec ($1 []) ($2 []) } - -Modules :: { L (ModuleName,[Tick]) } -Modules : Modules Module { $1 . ((:) $2) } - | { id } - -Module :: { (ModuleName,[Tick]) } -Module : MODULE string '{' TopTicks '}' - { ($2,$4 []) } - -TopTicks :: { L Tick } -TopTicks : TopTicks TopTick { $1 . ((:) $2) } - | { id } - -TopTick :: { Tick } -TopTick : Tick { ExprTick $1 } - | TICK FUNCTION string optQual optCat ';' - { TickFunction $3 $4 $5 } - | INSIDE string '{' TopTicks '}' - { InsideFunction $2 ($4 []) } - -Ticks :: { L ExprTick } -Ticks : Ticks Tick { $1 . ((:) $2) } - | { id } - -Tick :: { ExprTick } -Tick : TICK optString optQual optCat ';' - { TickExpression False $2 $3 $4 } - -optString :: { Maybe String } -optString : string { Just $1 } - | { Nothing } - -optQual :: { Maybe Qualifier } -optQual : ON LINE int { Just (OnLine $3) } - | AT POSITION int ':' int '-' int ':' int - { Just (AtPosition $3 $5 $7 $9) } - | { Nothing } -optCat :: { Maybe String } -optCat : cat { Just $1 } - | { Nothing } - -{ -type L a = [a] -> [a] - -type ModuleName = String - -data Spec - = Spec [ExprTick] [(ModuleName,[Tick])] - deriving (Show) - -data ExprTick - = TickExpression Bool (Maybe String) (Maybe Qualifier) (Maybe String) - deriving (Show) - -data Tick - = ExprTick ExprTick - | TickFunction String (Maybe Qualifier) (Maybe String) - | InsideFunction String [Tick] - deriving (Show) - -data Qualifier = OnLine Int - | AtPosition Int Int Int Int - deriving (Show) - - - -hpcParser :: String -> IO Spec -hpcParser filename = do - txt <- readFile filename - let tokens = initLexer txt - return $ parser tokens - -happyError e = error $ show (take 10 e) -} ===================================== utils/hpc/HpcReport.hs deleted ===================================== @@ -1,277 +0,0 @@ ---------------------------------------------------------- --- The main program for the hpc-report tool, part of HPC. --- Colin Runciman and Andy Gill, June 2006 ---------------------------------------------------------- - -module HpcReport (report_plugin) where - -import Prelude hiding (exp) -import Data.List(sort,intersperse,sortBy) -import HpcFlags -import Trace.Hpc.Mix -import Trace.Hpc.Tix -import Control.Monad hiding (guard) -import qualified Data.Set as Set - -notExpecting :: String -> a -notExpecting s = error ("not expecting "++s) - -data BoxTixCounts = BT {boxCount, tixCount :: !Int} - -btZero :: BoxTixCounts -btZero = BT {boxCount=0, tixCount=0} - -btPlus :: BoxTixCounts -> BoxTixCounts -> BoxTixCounts -btPlus (BT b1 t1) (BT b2 t2) = BT (b1+b2) (t1+t2) - -btPercentage :: String -> BoxTixCounts -> String -btPercentage s (BT b t) = showPercentage s t b - -showPercentage :: String -> Int -> Int -> String -showPercentage s 0 0 = "100% "++s++" (0/0)" -showPercentage s n d = showWidth 3 p++"% "++ - s++ - " ("++show n++"/"++show d++")" - where - p = (n*100) `div` d - showWidth w x0 = replicate (shortOf w (length sx)) ' ' ++ sx - where - sx = show x0 - shortOf x y = if y < x then x-y else 0 - -data BinBoxTixCounts = BBT { binBoxCount - , onlyTrueTixCount - , onlyFalseTixCount - , bothTixCount :: !Int} - -bbtzero :: BinBoxTixCounts -bbtzero = BBT { binBoxCount=0 - , onlyTrueTixCount=0 - , onlyFalseTixCount=0 - , bothTixCount=0} - -bbtPlus :: BinBoxTixCounts -> BinBoxTixCounts -> BinBoxTixCounts -bbtPlus (BBT b1 tt1 ft1 bt1) (BBT b2 tt2 ft2 bt2) = - BBT (b1+b2) (tt1+tt2) (ft1+ft2) (bt1+bt2) - -bbtPercentage :: String -> Bool -> BinBoxTixCounts -> String -bbtPercentage s withdetail (BBT b tt ft bt) = - showPercentage s bt b ++ - if withdetail && bt/=b then - detailFor tt "always True"++ - detailFor ft "always False"++ - detailFor (b-(tt+ft+bt)) "unevaluated" - else "" - where - detailFor n txt = if n>0 then ", "++show n++" "++txt - else "" - -data ModInfo = MI { exp,alt,top,loc :: !BoxTixCounts - , guard,cond,qual :: !BinBoxTixCounts - , decPaths :: [[String]]} - -miZero :: ModInfo -miZero = MI { exp=btZero - , alt=btZero - , top=btZero - , loc=btZero - , guard=bbtzero - , cond=bbtzero - , qual=bbtzero - , decPaths = []} - -miPlus :: ModInfo -> ModInfo -> ModInfo -miPlus mi1 mi2 = - MI { exp = exp mi1 `btPlus` exp mi2 - , alt = alt mi1 `btPlus` alt mi2 - , top = top mi1 `btPlus` top mi2 - , loc = loc mi1 `btPlus` loc mi2 - , guard = guard mi1 `bbtPlus` guard mi2 - , cond = cond mi1 `bbtPlus` cond mi2 - , qual = qual mi1 `bbtPlus` qual mi2 - , decPaths = decPaths mi1 ++ decPaths mi2 } - -allBinCounts :: ModInfo -> BinBoxTixCounts -allBinCounts mi = - BBT { binBoxCount = sumAll binBoxCount - , onlyTrueTixCount = sumAll onlyTrueTixCount - , onlyFalseTixCount = sumAll onlyFalseTixCount - , bothTixCount = sumAll bothTixCount } - where - sumAll f = f (guard mi) + f (cond mi) + f (qual mi) - -accumCounts :: [(BoxLabel,Integer)] -> ModInfo -> ModInfo -accumCounts [] mi = mi -accumCounts ((bl,btc):etc) mi - | single bl = accumCounts etc mi' - where - mi' = case bl of - ExpBox False -> mi{exp = inc (exp mi)} - ExpBox True -> mi{exp = inc (exp mi), alt = inc (alt mi)} - TopLevelBox dp -> mi{top = inc (top mi) - ,decPaths = upd dp (decPaths mi)} - LocalBox dp -> mi{loc = inc (loc mi) - ,decPaths = upd dp (decPaths mi)} - _other -> notExpecting "BoxLabel in accumcounts" - inc (BT {boxCount=bc,tixCount=tc}) = - BT { boxCount = bc+1 - , tixCount = tc + bit (btc>0) } - upd dp dps = - if btc>0 then dps else dp:dps -accumCounts [_] _ = error "accumCounts: Unhandled case: [_] _" -accumCounts ((bl0,btc0):(bl1,btc1):etc) mi = - accumCounts etc mi' - where - mi' = case (bl0,bl1) of - (BinBox GuardBinBox True, BinBox GuardBinBox False) -> - mi{guard = inc (guard mi)} - (BinBox CondBinBox True, BinBox CondBinBox False) -> - mi{cond = inc (cond mi)} - (BinBox QualBinBox True, BinBox QualBinBox False) -> - mi{qual = inc (qual mi)} - _other -> notExpecting "BoxLabel pair in accumcounts" - inc (BBT { binBoxCount=bbc - , onlyTrueTixCount=ttc - , onlyFalseTixCount=ftc - , bothTixCount=btc}) = - BBT { binBoxCount = bbc+1 - , onlyTrueTixCount = ttc + bit (btc0 >0 && btc1==0) - , onlyFalseTixCount = ftc + bit (btc0==0 && btc1 >0) - , bothTixCount = btc + bit (btc0 >0 && btc1 >0) } - -bit :: Bool -> Int -bit True = 1 -bit False = 0 - -single :: BoxLabel -> Bool -single (ExpBox {}) = True -single (TopLevelBox _) = True -single (LocalBox _) = True -single (BinBox {}) = False - -modInfo :: Flags -> Bool -> TixModule -> IO ModInfo -modInfo hpcflags qualDecList tix@(TixModule moduleName _ _ tickCounts) = do - Mix _ _ _ _ mes <- readMixWithFlags hpcflags (Right tix) - return (q (accumCounts (zip (map snd mes) tickCounts) miZero)) - where - q mi = if qualDecList then mi{decPaths = map (moduleName:) (decPaths mi)} - else mi - -modReport :: Flags -> TixModule -> IO () -modReport hpcflags tix@(TixModule moduleName _ _ _) = do - mi <- modInfo hpcflags False tix - if xmlOutput hpcflags - then putStrLn $ " " - else putStrLn ("----------") - printModInfo hpcflags mi - if xmlOutput hpcflags - then putStrLn $ " " - else return () - -printModInfo :: Flags -> ModInfo -> IO () -printModInfo hpcflags mi | xmlOutput hpcflags = do - element "exprs" (xmlBT $ exp mi) - element "booleans" (xmlBBT $ allBinCounts mi) - element "guards" (xmlBBT $ guard mi) - element "conditionals" (xmlBBT $ cond mi) - element "qualifiers" (xmlBBT $ qual mi) - element "alts" (xmlBT $ alt mi) - element "local" (xmlBT $ loc mi) - element "toplevel" (xmlBT $ top mi) -printModInfo hpcflags mi = do - putStrLn (btPercentage "expressions used" (exp mi)) - putStrLn (bbtPercentage "boolean coverage" False (allBinCounts mi)) - putStrLn (" "++bbtPercentage "guards" True (guard mi)) - putStrLn (" "++bbtPercentage "'if' conditions" True (cond mi)) - putStrLn (" "++bbtPercentage "qualifiers" True (qual mi)) - putStrLn (btPercentage "alternatives used" (alt mi)) - putStrLn (btPercentage "local declarations used" (loc mi)) - putStrLn (btPercentage "top-level declarations used" (top mi)) - modDecList hpcflags mi - -modDecList :: Flags -> ModInfo -> IO () -modDecList hpcflags mi0 = - when (decList hpcflags && someDecsUnused mi0) $ do - putStrLn "unused declarations:" - mapM_ showDecPath (sort (decPaths mi0)) - where - someDecsUnused mi = tixCount (top mi) < boxCount (top mi) || - tixCount (loc mi) < boxCount (loc mi) - showDecPath dp = putStrLn (" "++ - concat (intersperse "." dp)) - -report_plugin :: Plugin -report_plugin = Plugin { name = "report" - , usage = "[OPTION] .. [ [ ..]]" - , options = report_options - , summary = "Output textual report about program coverage" - , implementation = report_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -report_main :: Flags -> [String] -> IO () -report_main hpcflags (progName:mods) = do - let hpcflags1 = hpcflags - { includeMods = Set.fromList mods - `Set.union` - includeMods hpcflags } - let prog = getTixFileName $ progName - tix <- readTix prog - case tix of - Just (Tix tickCounts) -> - makeReport hpcflags1 progName - $ sortBy (\ mod1 mod2 -> tixModuleName mod1 `compare` tixModuleName mod2) - $ [ tix' - | tix'@(TixModule m _ _ _) <- tickCounts - , allowModule hpcflags1 m - ] - Nothing -> hpcError report_plugin $ "unable to find tix file for:" ++ progName -report_main _ [] = - hpcError report_plugin $ "no .tix file or executable name specified" - -makeReport :: Flags -> String -> [TixModule] -> IO () -makeReport hpcflags progName modTcs | xmlOutput hpcflags = do - putStrLn $ "" - putStrLn $ "" - if perModule hpcflags - then mapM_ (modReport hpcflags) modTcs - else return () - mis <- mapM (modInfo hpcflags True) modTcs - putStrLn $ " " - printModInfo hpcflags (foldr miPlus miZero mis) - putStrLn $ " " - putStrLn $ "" -makeReport hpcflags _ modTcs = - if perModule hpcflags then - mapM_ (modReport hpcflags) modTcs - else do - mis <- mapM (modInfo hpcflags True) modTcs - printModInfo hpcflags (foldr miPlus miZero mis) - -element :: String -> [(String,String)] -> IO () -element tag attrs = putStrLn $ - " <" ++ tag ++ " " - ++ unwords [ x ++ "=" ++ show y - | (x,y) <- attrs - ] ++ "/>" - -xmlBT :: BoxTixCounts -> [(String, String)] -xmlBT (BT b t) = [("boxes",show b),("count",show t)] - -xmlBBT :: BinBoxTixCounts -> [(String, String)] -xmlBBT (BBT b tt tf bt) = [("boxes",show b),("true",show tt),("false",show tf),("count",show (tt + tf + bt))] - ------------------------------------------------------------------------------- - -report_options :: FlagOptSeq -report_options - = perModuleOpt - . decListOpt - . excludeOpt - . includeOpt - . srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . xmlOutputOpt - . verbosityOpt ===================================== utils/hpc/HpcShowTix.hs deleted ===================================== @@ -1,63 +0,0 @@ -module HpcShowTix (showtix_plugin) where - -import Trace.Hpc.Mix -import Trace.Hpc.Tix - -import HpcFlags - -import qualified Data.Set as Set - -showtix_options :: FlagOptSeq -showtix_options - = excludeOpt - . includeOpt - . srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . outputOpt - . verbosityOpt - -showtix_plugin :: Plugin -showtix_plugin = Plugin { name = "show" - , usage = "[OPTION] .. [ [ ..]]" - , options = showtix_options - , summary = "Show .tix file in readable, verbose format" - , implementation = showtix_main - , init_flags = default_flags - , final_flags = default_final_flags - } - - -showtix_main :: Flags -> [String] -> IO () -showtix_main _ [] = hpcError showtix_plugin $ "no .tix file or executable name specified" -showtix_main flags (prog:modNames) = do - let hpcflags1 = flags - { includeMods = Set.fromList modNames - `Set.union` - includeMods flags } - - optTixs <- readTix (getTixFileName prog) - case optTixs of - Nothing -> hpcError showtix_plugin $ "could not read .tix file : " ++ prog - Just (Tix tixs) -> do - tixs_mixs <- sequence - [ do mix <- readMixWithFlags hpcflags1 (Right tix) - return $ (tix,mix) - | tix <- tixs - , allowModule hpcflags1 (tixModuleName tix) - ] - - let rjust n str = take (n - length str) (repeat ' ') ++ str - let ljust n str = str ++ take (n - length str) (repeat ' ') - - sequence_ [ sequence_ [ putStrLn (rjust 5 (show ix) ++ " " ++ - rjust 10 (show count) ++ " " ++ - ljust 20 modName ++ " " ++ rjust 20 (show pos) ++ " " ++ show lab) - | (count,ix,(pos,lab)) <- zip3 tixs' [(0::Int)..] entries - ] - | ( TixModule modName _hash1 _ tixs' - , Mix _file _timestamp _hash2 _tab entries - ) <- tixs_mixs - ] - - return () ===================================== utils/hpc/HpcUtils.hs deleted ===================================== @@ -1,37 +0,0 @@ -module HpcUtils where - -import Trace.Hpc.Util (catchIO, HpcPos, fromHpcPos, readFileUtf8) -import qualified Data.Map as Map -import System.FilePath - -dropWhileEndLE :: (a -> Bool) -> [a] -> [a] --- Spec: dropWhileEndLE p = reverse . dropWhile p . reverse -dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x:r) [] - --- turns \n into ' ' --- | grab's the text behind a HpcPos; -grabHpcPos :: Map.Map Int String -> HpcPos -> String -grabHpcPos hsMap srcspan = - case lns of - [] -> error "grabHpcPos: invalid source span" - [ln] -> (take ((c2 - c1) + 1) $ drop (c1 - 1) ln) - hd : tl -> - let lns1 = drop (c1 -1) hd : tl - lns2 = init lns1 ++ [take (c2 + 1) (last lns1) ] - in foldl1 (\ xs ys -> xs ++ "\n" ++ ys) lns2 - where (l1,c1,l2,c2) = fromHpcPos srcspan - lns = map (\ n -> case Map.lookup n hsMap of - Just ln -> ln - Nothing -> error $ "bad line number : " ++ show n - ) [l1..l2] - - -readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String -readFileFromPath _ filename@('/':_) _ = readFileUtf8 filename -readFileFromPath err filename path0 = readTheFile path0 - where - readTheFile [] = err $ "could not find " ++ show filename - ++ " in path " ++ show path0 - readTheFile (dir:dirs) = - catchIO (readFileUtf8 (dir filename)) - (\ _ -> readTheFile dirs) ===================================== utils/hpc/Main.hs deleted ===================================== @@ -1,217 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables, TupleSections #-} --- (c) 2007 Andy Gill - --- Main driver for Hpc -import Control.Monad (forM, forM_, when) -import Data.Bifunctor (bimap) -import Data.List (intercalate, partition, uncons) -import Data.List.NonEmpty (NonEmpty((:|))) -import Data.Maybe (catMaybes, isJust) -import Data.Version -import System.Environment -import System.Exit -import System.Console.GetOpt -import System.Directory (doesPathExist) - -import HpcFlags -import HpcReport -import HpcMarkup -import HpcCombine -import HpcShowTix -import HpcDraft -import HpcOverlay -import Paths_hpc_bin - -helpList :: IO () -helpList = do - putStrLn $ - "Usage: hpc COMMAND ...\n\n" ++ - section "Commands" help ++ - section "Reporting Coverage" reporting ++ - section "Processing Coverage files" processing ++ - section "Coverage Overlays" overlays ++ - section "Others" other ++ - "" - putStrLn "" - putStrLn "or: hpc @response_file_1 @response_file_2 ..." - putStrLn "" - putStrLn "The contents of a Response File must have this format:" - putStrLn "COMMAND ..." - putStrLn "" - putStrLn "example:" - putStrLn "report my_library.tix --include=ModuleA \\" - putStrLn "--include=ModuleB" - where - help = ["help"] - reporting = ["report","markup"] - overlays = ["overlay","draft"] - processing = ["sum","combine","map"] - other = [ name hook - | hook <- hooks - , name hook `notElem` - (concat [help,reporting,processing,overlays]) - ] - -section :: String -> [String] -> String -section _ [] = "" -section msg cmds = msg ++ ":\n" - ++ unlines [ take 14 (" " ++ cmd ++ repeat ' ') ++ summary hook - | cmd <- cmds - , hook <- hooks - , name hook == cmd - ] - -dispatch :: [String] -> IO () -dispatch [] = do - helpList - exitWith ExitSuccess -dispatch (txt:args0) = do - case lookup txt hooks' of - Just plugin -> parse plugin args0 - _ -> case getResponseFileName txt of - Nothing -> parse help_plugin (txt:args0) - Just firstResponseFileName -> do - let - (responseFileNames', nonResponseFileNames) = partitionFileNames args0 - -- if arguments are combination of Response Files and non-Response Files, exit with error - when (length nonResponseFileNames > 0) $ do - let - putStrLn $ "First argument '" <> txt <> "' is a Response File, " <> - "followed by non-Response File(s): '" <> intercalate "', '" nonResponseFileNames <> "'" - putStrLn $ "When first argument is a Response File, " <> - "all arguments should be Response Files." - exitFailure - let - responseFileNames :: NonEmpty FilePath - responseFileNames = firstResponseFileName :| responseFileNames' - - forM_ responseFileNames $ \responseFileName -> do - exists <- doesPathExist responseFileName - when (not exists) $ do - putStrLn $ "Response File '" <> responseFileName <> "' does not exist" - exitFailure - - -- read all Response Files - responseFileNamesAndText :: NonEmpty (FilePath, String) <- - forM responseFileNames $ \responseFileName -> - fmap (responseFileName, ) (readFile responseFileName) - forM_ responseFileNamesAndText $ \(responseFileName, responseFileText) -> - -- parse first word of Response File, which should be a command - case uncons $ words responseFileText of - Nothing -> do - putStrLn $ "Response File '" <> responseFileName <> "' has no command" - exitFailure - Just (responseFileCommand, args1) -> case lookup responseFileCommand hooks' of - -- check command for validity - -- It is important than a Response File cannot specify another Response File; - -- this is prevented - Nothing -> do - putStrLn $ "Response File '" <> responseFileName <> - "' command '" <> responseFileCommand <> "' invalid" - exitFailure - Just plugin -> do - putStrLn $ "Response File '" <> responseFileName <> "':" - parse plugin args1 - - where - getResponseFileName :: String -> Maybe FilePath - getResponseFileName s = do - (firstChar, filename) <- uncons s - if firstChar == '@' - then pure filename - else Nothing - - -- first member of tuple is list of Response File names, - -- second member of tuple is list of all other arguments - partitionFileNames :: [String] -> ([FilePath], [String]) - partitionFileNames xs = let - hasFileName :: [(String, Maybe FilePath)] - hasFileName = fmap (\x -> (x, getResponseFileName x)) xs - (fileNames, nonFileNames) :: ([Maybe FilePath], [String]) = - bimap (fmap snd) (fmap fst) $ partition (isJust . snd) hasFileName - in (catMaybes fileNames, nonFileNames) - - parse plugin args = - case getOpt Permute (options plugin []) args of - (_,_,errs) | not (null errs) - -> do putStrLn "hpc failed:" - sequence_ [ putStr (" " ++ err) - | err <- errs - ] - putStrLn $ "\n" - command_usage plugin - exitFailure - (o,ns,_) -> do - let flags = final_flags plugin - . foldr (.) id o - $ init_flags plugin - implementation plugin flags ns - -main :: IO () -main = do - args <- getArgs - dispatch args - ------------------------------------------------------------------------------- - -hooks :: [Plugin] -hooks = [ help_plugin - , report_plugin - , markup_plugin - , sum_plugin - , combine_plugin - , map_plugin - , showtix_plugin - , overlay_plugin - , draft_plugin - , version_plugin - ] - -hooks' :: [(String, Plugin)] -hooks' = [ (name hook,hook) | hook <- hooks ] - ------------------------------------------------------------------------------- - -help_plugin :: Plugin -help_plugin = Plugin { name = "help" - , usage = "[]" - , summary = "Display help for hpc or a single command" - , options = help_options - , implementation = help_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -help_main :: Flags -> [String] -> IO () -help_main _ [] = do - helpList - exitWith ExitSuccess -help_main _ (sub_txt:_) = do - case lookup sub_txt hooks' of - Nothing -> do - putStrLn $ "no such HPC command: " <> sub_txt - exitFailure - Just plugin' -> do - command_usage plugin' - exitWith ExitSuccess - -help_options :: FlagOptSeq -help_options = id - ------------------------------------------------------------------------------- - -version_plugin :: Plugin -version_plugin = Plugin { name = "version" - , usage = "" - , summary = "Display version for hpc" - , options = id - , implementation = version_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -version_main :: Flags -> [String] -> IO () -version_main _ _ = putStrLn ("hpc tools, version " ++ showVersion version) - - ------------------------------------------------------------------------------- ===================================== utils/hpc/Makefile deleted ===================================== @@ -1,15 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -dir = utils/hpc -TOP = ../.. -include $(TOP)/mk/sub-makefile.mk ===================================== utils/hpc/hpc-bin.cabal deleted ===================================== @@ -1,44 +0,0 @@ -Name: hpc-bin --- XXX version number: -Version: 0.68 -Copyright: XXX -License: BSD3 --- XXX License-File: LICENSE -Author: XXX -Maintainer: XXX -Synopsis: XXX -Description: XXX -Category: Development -build-type: Simple -cabal-version: 2.0 - -Flag build-tool-depends - Description: Use build-tool-depends - Default: True - -Executable hpc - Default-Language: Haskell2010 - Main-Is: Main.hs - Other-Modules: HpcParser - HpcCombine - HpcDraft - HpcFlags - HpcLexer - HpcMarkup - HpcOverlay - HpcReport - HpcShowTix - HpcUtils - Paths_hpc_bin - - autogen-modules: Paths_hpc_bin - - Build-Depends: base >= 4 && < 5, - directory >= 1 && < 1.4, - filepath >= 1 && < 1.5, - containers >= 0.1 && < 0.7, - array >= 0.1 && < 0.6, - hpc >= 0.6.1 && < 0.7 - - if flag(build-tool-depends) - build-tool-depends: happy:happy >= 1.20.0 ===================================== utils/hpc/hpc.wrapper deleted ===================================== @@ -1,2 +0,0 @@ -#!/bin/sh -exec "$executablename" ${1+"$@"} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a8c6d55ba0dab16ba857cca30fc958f72ac55a42...4cacd04265bc8a210f0c1ff5ee156b937bbfcd26 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a8c6d55ba0dab16ba857cca30fc958f72ac55a42...4cacd04265bc8a210f0c1ff5ee156b937bbfcd26 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 06:24:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Mar 2023 01:24:51 -0500 Subject: [Git][ghc/ghc][master] 4 commits: Remove utils/hpc subdirectory and its contents Message-ID: <64082a334cac1_2c78e9158f12f8361571@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 16 changed files: - .gitmodules - + utils/hpc - − utils/hpc/HpcCombine.hs - − utils/hpc/HpcDraft.hs - − utils/hpc/HpcFlags.hs - − utils/hpc/HpcLexer.hs - − utils/hpc/HpcMarkup.hs - − utils/hpc/HpcOverlay.hs - − utils/hpc/HpcParser.y - − utils/hpc/HpcReport.hs - − utils/hpc/HpcShowTix.hs - − utils/hpc/HpcUtils.hs - − utils/hpc/Main.hs - − utils/hpc/Makefile - − utils/hpc/hpc-bin.cabal - − utils/hpc/hpc.wrapper Changes: ===================================== .gitmodules ===================================== @@ -110,3 +110,6 @@ [submodule "libraries/exceptions"] path = libraries/exceptions url = https://gitlab.haskell.org/ghc/packages/exceptions.git +[submodule "utils/hpc"] + path = utils/hpc + url = https://gitlab.haskell.org/hpc/hpc-bin.git ===================================== utils/hpc ===================================== @@ -0,0 +1 @@ +Subproject commit b376045cb3f3d28815ca29d9c07df2e843cec1c3 ===================================== utils/hpc/HpcCombine.hs deleted ===================================== @@ -1,197 +0,0 @@ ---------------------------------------------------------- --- The main program for the hpc-add tool, part of HPC. --- Andy Gill, Oct 2006 ---------------------------------------------------------- - -module HpcCombine (sum_plugin,combine_plugin,map_plugin) where - -import Trace.Hpc.Tix -import Trace.Hpc.Util - -import HpcFlags - -import Control.Monad -import qualified Data.Set as Set -import qualified Data.Map as Map - ------------------------------------------------------------------------------- -sum_options :: FlagOptSeq -sum_options - = excludeOpt - . includeOpt - . outputOpt - . unionModuleOpt - . verbosityOpt - -sum_plugin :: Plugin -sum_plugin = Plugin { name = "sum" - , usage = "[OPTION] .. [ [ ..]]" - , options = sum_options - , summary = "Sum multiple .tix files in a single .tix file" - , implementation = sum_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -combine_options :: FlagOptSeq -combine_options - = excludeOpt - . includeOpt - . outputOpt - . combineFunOpt - . combineFunOptInfo - . unionModuleOpt - . verbosityOpt - -combine_plugin :: Plugin -combine_plugin = Plugin { name = "combine" - , usage = "[OPTION] .. " - , options = combine_options - , summary = "Combine two .tix files in a single .tix file" - , implementation = combine_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -map_options :: FlagOptSeq -map_options - = excludeOpt - . includeOpt - . outputOpt - . mapFunOpt - . mapFunOptInfo - . unionModuleOpt - . verbosityOpt - -map_plugin :: Plugin -map_plugin = Plugin { name = "map" - , usage = "[OPTION] .. " - , options = map_options - , summary = "Map a function over a single .tix file" - , implementation = map_main - , init_flags = default_flags - , final_flags = default_final_flags - } - ------------------------------------------------------------------------------- - -sum_main :: Flags -> [String] -> IO () -sum_main _ [] = hpcError sum_plugin $ "no .tix file specified" -sum_main flags (first_file:more_files) = do - Just tix <- readTix first_file - - tix' <- foldM (mergeTixFile flags (+)) - (filterTix flags tix) - more_files - - case outputFile flags of - "-" -> putStrLn (show tix') - out -> writeTix out tix' - -combine_main :: Flags -> [String] -> IO () -combine_main flags [first_file,second_file] = do - let f = theCombineFun (combineFun flags) - - Just tix1 <- readTix first_file - Just tix2 <- readTix second_file - - let tix = mergeTix (mergeModule flags) - f - (filterTix flags tix1) - (filterTix flags tix2) - - case outputFile flags of - "-" -> putStrLn (show tix) - out -> writeTix out tix -combine_main _ _ = hpcError combine_plugin $ "need exactly two .tix files to combine" - -map_main :: Flags -> [String] -> IO () -map_main flags [first_file] = do - let f = thePostFun (postFun flags) - - Just tix <- readTix first_file - - let (Tix inside_tix) = filterTix flags tix - let tix' = Tix [ TixModule m p i (map f t) - | TixModule m p i t <- inside_tix - ] - - case outputFile flags of - "-" -> putStrLn (show tix') - out -> writeTix out tix' -map_main _ [] = hpcError map_plugin $ "no .tix file specified" -map_main _ _ = hpcError map_plugin $ "to many .tix files specified" - -mergeTixFile :: Flags -> (Integer -> Integer -> Integer) -> Tix -> String -> IO Tix -mergeTixFile flags fn tix file_name = do - Just new_tix <- readTix file_name - return $! strict $ mergeTix (mergeModule flags) fn tix (filterTix flags new_tix) - --- could allow different numbering on the module info, --- as long as the total is the same; will require normalization. - -mergeTix :: MergeFun - -> (Integer -> Integer -> Integer) -> Tix -> Tix -> Tix -mergeTix modComb f - (Tix t1) - (Tix t2) = Tix - [ case (Map.lookup m fm1,Map.lookup m fm2) of - -- todo, revisit the semantics of this combination - (Just (TixModule _ hash1 len1 tix1),Just (TixModule _ hash2 len2 tix2)) - | hash1 /= hash2 - || length tix1 /= length tix2 - || len1 /= length tix1 - || len2 /= length tix2 - -> error $ "mismatched in module " ++ m - | otherwise -> - TixModule m hash1 len1 (zipWith f tix1 tix2) - (Just m1,Nothing) -> - m1 - (Nothing,Just m2) -> - m2 - _ -> error "impossible" - | m <- Set.toList (theMergeFun modComb m1s m2s) - ] - where - m1s = Set.fromList $ map tixModuleName t1 - m2s = Set.fromList $ map tixModuleName t2 - - fm1 = Map.fromList [ (tixModuleName tix,tix) - | tix <- t1 - ] - fm2 = Map.fromList [ (tixModuleName tix,tix) - | tix <- t2 - ] - - --- What I would give for a hyperstrict :-) --- This makes things about 100 times faster. -class Strict a where - strict :: a -> a - -instance Strict Integer where - strict i = i - -instance Strict Int where - strict i = i - -instance Strict Hash where -- should be fine, because Hash is a newtype round an Int - strict i = i - -instance Strict Char where - strict i = i - -instance Strict a => Strict [a] where - strict (a:as) = (((:) $! strict a) $! strict as) - strict [] = [] - -instance (Strict a, Strict b) => Strict (a,b) where - strict (a,b) = (((,) $! strict a) $! strict b) - -instance Strict Tix where - strict (Tix t1) = - Tix $! strict t1 - -instance Strict TixModule where - strict (TixModule m1 p1 i1 t1) = - ((((TixModule $! strict m1) $! strict p1) $! strict i1) $! strict t1) ===================================== utils/hpc/HpcDraft.hs deleted ===================================== @@ -1,144 +0,0 @@ -module HpcDraft (draft_plugin) where - -import Trace.Hpc.Tix -import Trace.Hpc.Mix -import Trace.Hpc.Util - -import HpcFlags - -import qualified Data.Set as Set -import qualified Data.Map as Map -import HpcUtils -import Data.Tree - ------------------------------------------------------------------------------- -draft_options :: FlagOptSeq -draft_options - = excludeOpt - . includeOpt - . srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . outputOpt - . verbosityOpt - -draft_plugin :: Plugin -draft_plugin = Plugin { name = "draft" - , usage = "[OPTION] .. " - , options = draft_options - , summary = "Generate draft overlay that provides 100% coverage" - , implementation = draft_main - , init_flags = default_flags - , final_flags = default_final_flags - } - ------------------------------------------------------------------------------- - -draft_main :: Flags -> [String] -> IO () -draft_main _ [] = error "draft_main: unhandled case: []" -draft_main hpcflags (progName:mods) = do - let hpcflags1 = hpcflags - { includeMods = Set.fromList mods - `Set.union` - includeMods hpcflags } - let prog = getTixFileName $ progName - tix <- readTix prog - case tix of - Just (Tix tickCounts) -> do - outs <- sequence - [ makeDraft hpcflags1 tixModule - | tixModule@(TixModule m _ _ _) <- tickCounts - , allowModule hpcflags1 m - ] - case outputFile hpcflags1 of - "-" -> putStrLn (unlines outs) - out -> writeFile out (unlines outs) - Nothing -> hpcError draft_plugin $ "unable to find tix file for:" ++ progName - - -makeDraft :: Flags -> TixModule -> IO String -makeDraft hpcflags tix = do - let modu = tixModuleName tix - tixs = tixModuleTixs tix - - (Mix filepath _ _ _ entries) <- readMixWithFlags hpcflags (Right tix) - - let forest = createMixEntryDom - [ (srcspan,(box,v > 0)) - | ((srcspan,box),v) <- zip entries tixs - ] - --- let show' (span,stuff) = show (span,stuff,grabHpcPos hsMap span) --- putStrLn $ drawForest $ map (fmap show) $ forest - - let non_ticked = findNotTickedFromList forest - - hs <- readFileFromPath (hpcError draft_plugin) filepath (srcDirs hpcflags) - - let hsMap :: Map.Map Int String - hsMap = Map.fromList (zip [1..] $ lines hs) - - let quoteString = show - - let firstLine pos = case fromHpcPos pos of - (ln,_,_,_) -> ln - - - let showPleaseTick :: Int -> PleaseTick -> String - showPleaseTick d (TickFun str pos) = - spaces d ++ "tick function \"" ++ last str ++ "\" " - ++ "on line " ++ show (firstLine pos) ++ ";" - showPleaseTick d (TickExp pos) = - spaces d ++ "tick " - ++ if '\n' `elem` txt - then "at position " ++ show pos ++ ";" - else quoteString txt ++ " " ++ "on line " ++ show (firstLine pos) ++ ";" - - where - txt = grabHpcPos hsMap pos - - showPleaseTick d (TickInside [str] _ pleases) = - spaces d ++ "inside \"" ++ str ++ "\" {\n" ++ - showPleaseTicks (d + 2) pleases ++ - spaces d ++ "}" - - showPleaseTick _ (TickInside _ _ _) - = error "showPleaseTick: Unhandled case TickInside" - - showPleaseTicks d pleases = unlines (map (showPleaseTick d) pleases) - - spaces d = take d (repeat ' ') - - return $ "module " ++ show (fixPackageSuffix modu) ++ " {\n" ++ - showPleaseTicks 2 non_ticked ++ "}" - -fixPackageSuffix :: String -> String -fixPackageSuffix modu = case span (/= '/') modu of - (before,'/':after) -> before ++ ":" ++ after - _ -> modu - -data PleaseTick - = TickFun [String] HpcPos - | TickExp HpcPos - | TickInside [String] HpcPos [PleaseTick] - deriving Show - -mkTickInside :: [String] -> HpcPos -> [PleaseTick] - -> [PleaseTick] -> [PleaseTick] -mkTickInside _ _ [] = id -mkTickInside nm pos inside = (TickInside nm pos inside :) - -findNotTickedFromTree :: MixEntryDom [(BoxLabel,Bool)] -> [PleaseTick] -findNotTickedFromTree (Node (pos,(ExpBox {},False):_) _) = [TickExp pos] -findNotTickedFromTree (Node (pos,(TopLevelBox nm,False):_) _) - = [ TickFun nm pos ] -findNotTickedFromTree (Node (pos,(LocalBox nm,False):_) _) - = [ TickFun nm pos ] -findNotTickedFromTree (Node (pos,(TopLevelBox nm,True):_) children) - = mkTickInside nm pos (findNotTickedFromList children) [] -findNotTickedFromTree (Node (pos,_:others) children) = - findNotTickedFromTree (Node (pos,others) children) -findNotTickedFromTree (Node (_, []) children) = findNotTickedFromList children - -findNotTickedFromList :: [MixEntryDom [(BoxLabel,Bool)]] -> [PleaseTick] -findNotTickedFromList = concatMap findNotTickedFromTree ===================================== utils/hpc/HpcFlags.hs deleted ===================================== @@ -1,268 +0,0 @@ --- (c) 2007 Andy Gill - -module HpcFlags where - -import System.Console.GetOpt -import qualified Data.Set as Set -import Data.Char -import Trace.Hpc.Tix -import Trace.Hpc.Mix -import System.Exit -import System.FilePath - -data Flags = Flags - { outputFile :: String - , includeMods :: Set.Set String - , excludeMods :: Set.Set String - , hpcDirs :: [String] - , srcDirs :: [String] - , destDir :: String - - , perModule :: Bool - , decList :: Bool - , xmlOutput :: Bool - - , funTotals :: Bool - , altHighlight :: Bool - - , combineFun :: CombineFun -- tick-wise combine - , postFun :: PostFun -- - , mergeModule :: MergeFun -- module-wise merge - - , verbosity :: Verbosity - } - -default_flags :: Flags -default_flags = Flags - { outputFile = "-" - , includeMods = Set.empty - , excludeMods = Set.empty - , hpcDirs = [".hpc"] - , srcDirs = [] - , destDir = "." - - , perModule = False - , decList = False - , xmlOutput = False - - , funTotals = False - , altHighlight = False - - , combineFun = ADD - , postFun = ID - , mergeModule = INTERSECTION - - , verbosity = Normal - } - - -data Verbosity = Silent | Normal | Verbose - deriving (Eq, Ord) - -verbosityFromString :: String -> Verbosity -verbosityFromString "0" = Silent -verbosityFromString "1" = Normal -verbosityFromString "2" = Verbose -verbosityFromString v = error $ "unknown verbosity: " ++ v - - --- We do this after reading flags, because the defaults --- depends on if specific flags we used. - -default_final_flags :: Flags -> Flags -default_final_flags flags = flags - { srcDirs = if null (srcDirs flags) - then ["."] - else srcDirs flags - } - -type FlagOptSeq = [OptDescr (Flags -> Flags)] -> [OptDescr (Flags -> Flags)] - -noArg :: String -> String -> (Flags -> Flags) -> FlagOptSeq -noArg flag detail fn = (:) $ Option [] [flag] (NoArg $ fn) detail - -anArg :: String -> String -> String -> (String -> Flags -> Flags) -> FlagOptSeq -anArg flag detail argtype fn = (:) $ Option [] [flag] (ReqArg fn argtype) detail - -infoArg :: String -> FlagOptSeq -infoArg info = (:) $ Option [] [] (NoArg $ id) info - -excludeOpt, includeOpt, hpcDirOpt, resetHpcDirsOpt, srcDirOpt, - destDirOpt, outputOpt, verbosityOpt, - perModuleOpt, decListOpt, xmlOutputOpt, funTotalsOpt, - altHighlightOpt, combineFunOpt, combineFunOptInfo, mapFunOpt, - mapFunOptInfo, unionModuleOpt :: FlagOptSeq -excludeOpt = anArg "exclude" "exclude MODULE and/or PACKAGE" "[PACKAGE:][MODULE]" - $ \ a f -> f { excludeMods = a `Set.insert` excludeMods f } - -includeOpt = anArg "include" "include MODULE and/or PACKAGE" "[PACKAGE:][MODULE]" - $ \ a f -> f { includeMods = a `Set.insert` includeMods f } - -hpcDirOpt = anArg "hpcdir" "append sub-directory that contains .mix files" "DIR" - (\ a f -> f { hpcDirs = hpcDirs f ++ [a] }) - . infoArg "default .hpc [rarely used]" - -resetHpcDirsOpt = noArg "reset-hpcdirs" "empty the list of hpcdir's" - (\ f -> f { hpcDirs = [] }) - . infoArg "[rarely used]" - -srcDirOpt = anArg "srcdir" "path to source directory of .hs files" "DIR" - (\ a f -> f { srcDirs = srcDirs f ++ [a] }) - . infoArg "multi-use of srcdir possible" - -destDirOpt = anArg "destdir" "path to write output to" "DIR" - $ \ a f -> f { destDir = a } - - -outputOpt = anArg "output" "output FILE" "FILE" $ \ a f -> f { outputFile = a } - -verbosityOpt = anArg "verbosity" "verbosity level, 0-2" "[0-2]" - (\ a f -> f { verbosity = verbosityFromString a }) - . infoArg "default 1" - --- markup - -perModuleOpt = noArg "per-module" "show module level detail" $ \ f -> f { perModule = True } -decListOpt = noArg "decl-list" "show unused decls" $ \ f -> f { decList = True } -xmlOutputOpt = noArg "xml-output" "show output in XML" $ \ f -> f { xmlOutput = True } -funTotalsOpt = noArg "fun-entry-count" "show top-level function entry counts" - $ \ f -> f { funTotals = True } -altHighlightOpt - = noArg "highlight-covered" "highlight covered code, rather that code gaps" - $ \ f -> f { altHighlight = True } - -combineFunOpt = anArg "function" - "combine .tix files with join function, default = ADD" "FUNCTION" - $ \ a f -> case reads (map toUpper a) of - [(c,"")] -> f { combineFun = c } - _ -> error $ "no such combine function : " ++ a -combineFunOptInfo = infoArg - $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst foldFuns) - -mapFunOpt = anArg "function" - "apply function to .tix files, default = ID" "FUNCTION" - $ \ a f -> case reads (map toUpper a) of - [(c,"")] -> f { postFun = c } - _ -> error $ "no such combine function : " ++ a -mapFunOptInfo = infoArg - $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst postFuns) - -unionModuleOpt = noArg "union" - "use the union of the module namespace (default is intersection)" - $ \ f -> f { mergeModule = UNION } - - -------------------------------------------------------------------------------- - -readMixWithFlags :: Flags -> Either String TixModule -> IO Mix -readMixWithFlags flags modu = readMix [ dir hpcDir - | dir <- srcDirs flags - , hpcDir <- hpcDirs flags - ] modu - -------------------------------------------------------------------------------- - -command_usage :: Plugin -> IO () -command_usage plugin = - putStrLn $ - "Usage: hpc " ++ (name plugin) ++ " " ++ - (usage plugin) ++ - "\n" ++ summary plugin ++ "\n" ++ - if null (options plugin []) - then "" - else usageInfo "\n\nOptions:\n" (options plugin []) - -hpcError :: Plugin -> String -> IO a -hpcError plugin msg = do - putStrLn $ "Error: " ++ msg - command_usage plugin - exitFailure - -------------------------------------------------------------------------------- - -data Plugin = Plugin { name :: String - , usage :: String - , options :: FlagOptSeq - , summary :: String - , implementation :: Flags -> [String] -> IO () - , init_flags :: Flags - , final_flags :: Flags -> Flags - } - ------------------------------------------------------------------------------- - --- filterModules takes a list of candidate modules, --- and --- * excludes the excluded modules --- * includes the rest if there are no explicitly included modules --- * otherwise, accepts just the included modules. - -allowModule :: Flags -> String -> Bool -allowModule flags full_mod - | full_mod' `Set.member` excludeMods flags = False - | pkg_name `Set.member` excludeMods flags = False - | mod_name `Set.member` excludeMods flags = False - | Set.null (includeMods flags) = True - | full_mod' `Set.member` includeMods flags = True - | pkg_name `Set.member` includeMods flags = True - | mod_name `Set.member` includeMods flags = True - | otherwise = False - where - full_mod' = pkg_name ++ mod_name - -- pkg name always ends with '/', main - (pkg_name,mod_name) = - case span (/= '/') full_mod of - (p,'/':m) -> (p ++ ":",m) - (m,[]) -> (":",m) - _ -> error "impossible case in allowModule" - -filterTix :: Flags -> Tix -> Tix -filterTix flags (Tix tixs) = - Tix $ filter (allowModule flags . tixModuleName) tixs - - - ------------------------------------------------------------------------------- --- HpcCombine specifics - -data CombineFun = ADD | DIFF | SUB - deriving (Eq,Show, Read, Enum) - -theCombineFun :: CombineFun -> Integer -> Integer -> Integer -theCombineFun fn = case fn of - ADD -> \ l r -> l + r - SUB -> \ l r -> max 0 (l - r) - DIFF -> \ g b -> if g > 0 then 0 else min 1 b - -foldFuns :: [ (String,CombineFun) ] -foldFuns = [ (show comb,comb) - | comb <- [ADD .. SUB] - ] - -data PostFun = ID | INV | ZERO - deriving (Eq,Show, Read, Enum) - -thePostFun :: PostFun -> Integer -> Integer -thePostFun ID x = x -thePostFun INV 0 = 1 -thePostFun INV _ = 0 -thePostFun ZERO _ = 0 - -postFuns :: [(String, PostFun)] -postFuns = [ (show pos,pos) - | pos <- [ID .. ZERO] - ] - - -data MergeFun = INTERSECTION | UNION - deriving (Eq,Show, Read, Enum) - -theMergeFun :: (Ord a) => MergeFun -> Set.Set a -> Set.Set a -> Set.Set a -theMergeFun INTERSECTION = Set.intersection -theMergeFun UNION = Set.union - -mergeFuns :: [(String, MergeFun)] -mergeFuns = [ (show pos,pos) - | pos <- [INTERSECTION,UNION] - ] - ===================================== utils/hpc/HpcLexer.hs deleted ===================================== @@ -1,57 +0,0 @@ -module HpcLexer where - -import Data.Char - -data Token - = ID String - | SYM Char - | INT Int - | STR String - | CAT String - deriving (Eq,Show) - -initLexer :: String -> [Token] -initLexer str = [ t | (_,_,t) <- lexer str 1 1 ] - -lexer :: String -> Int -> Int -> [(Int,Int,Token)] -lexer (c:cs) line column - | c == '\n' = lexer cs (succ line) 1 - | c == '\"' = lexerSTR cs line (succ column) - | c == '[' = lexerCAT cs "" line (succ column) - | c `elem` "{};-:" - = (line,column,SYM c) : lexer cs line (succ column) - | isSpace c = lexer cs line (succ column) - | isAlpha c = lexerKW cs [c] line (succ column) - | isDigit c = lexerINT cs [c] line (succ column) - | otherwise = error "lexer failure" -lexer [] _ _ = [] - -lexerKW :: String -> String -> Int -> Int -> [(Int,Int,Token)] -lexerKW (c:cs) s line column - | isAlpha c = lexerKW cs (s ++ [c]) line (succ column) -lexerKW other s line column = (line,column,ID s) : lexer other line column - -lexerINT :: String -> String -> Int -> Int -> [(Int,Int,Token)] -lexerINT (c:cs) s line column - | isDigit c = lexerINT cs (s ++ [c]) line (succ column) -lexerINT other s line column = (line,column,INT (read s)) : lexer other line column - --- not technically correct for the new column count, but a good approximation. -lexerSTR :: String -> Int -> Int -> [(Int,Int,Token)] -lexerSTR cs line column - = case lex ('"' : cs) of - [(str,rest)] -> (line,succ column,STR (read str)) - : lexer rest line (length (show str) + column + 1) - _ -> error "bad string" - -lexerCAT :: String -> String -> Int -> Int -> [(Int,Int,Token)] -lexerCAT (c:cs) s line column - | c == ']' = (line,column,CAT s) : lexer cs line (succ column) - | otherwise = lexerCAT cs (s ++ [c]) line (succ column) -lexerCAT [] _ _ _ = error "lexer failure in CAT" - -test :: IO () -test = do - t <- readFile "EXAMPLE.tc" - print (initLexer t) - ===================================== utils/hpc/HpcMarkup.hs deleted ===================================== @@ -1,485 +0,0 @@ ---------------------------------------------------------- --- The main program for the hpc-markup tool, part of HPC. --- Andy Gill and Colin Runciman, June 2006 ---------------------------------------------------------- - -module HpcMarkup (markup_plugin) where - -import Trace.Hpc.Mix -import Trace.Hpc.Tix -import Trace.Hpc.Util (HpcPos, fromHpcPos, writeFileUtf8) - -import HpcFlags -import HpcUtils - -import System.FilePath -import Data.List (sortBy, find) -import Data.Maybe(fromJust) -import Data.Semigroup as Semi -import Data.Array -import Control.Monad -import qualified Data.Set as Set - ------------------------------------------------------------------------------- - -markup_options :: FlagOptSeq -markup_options - = excludeOpt - . includeOpt - . srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . funTotalsOpt - . altHighlightOpt - . destDirOpt - . verbosityOpt - -markup_plugin :: Plugin -markup_plugin = Plugin { name = "markup" - , usage = "[OPTION] .. [ [ ..]]" - , options = markup_options - , summary = "Markup Haskell source with program coverage" - , implementation = markup_main - , init_flags = default_flags - , final_flags = default_final_flags - } - ------------------------------------------------------------------------------- - -markup_main :: Flags -> [String] -> IO () -markup_main flags (prog:modNames) = do - let hpcflags1 = flags - { includeMods = Set.fromList modNames - `Set.union` - includeMods flags } - let Flags - { funTotals = theFunTotals - , altHighlight = invertOutput - , destDir = dest_dir - } = hpcflags1 - - mtix <- readTix (getTixFileName prog) - Tix tixs <- case mtix of - Nothing -> hpcError markup_plugin $ "unable to find tix file for: " ++ prog - Just a -> return a - - mods <- - sequence [ genHtmlFromMod dest_dir hpcflags1 tix theFunTotals invertOutput - | tix <- tixs - , allowModule hpcflags1 (tixModuleName tix) - ] - - let index_name = "hpc_index" - index_fun = "hpc_index_fun" - index_alt = "hpc_index_alt" - index_exp = "hpc_index_exp" - - let writeSummary filename cmp = do - let mods' = sortBy cmp mods - - unless (verbosity flags < Normal) $ - putStrLn $ "Writing: " ++ (filename <.> "html") - - writeFileUtf8 (dest_dir filename <.> "html") $ - "" ++ - "" ++ - "" ++ - "\n" ++ - "" ++ - "" ++ - "\n" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - concat [ showModuleSummary (modName,fileName,modSummary) - | (modName,fileName,modSummary) <- mods' - ] ++ - "" ++ - showTotalSummary (mconcat - [ modSummary - | (_,_,modSummary) <- mods' - ]) - ++ "
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
\n" - - writeSummary index_name $ \ (n1,_,_) (n2,_,_) -> compare n1 n2 - - writeSummary index_fun $ \ (_,_,s1) (_,_,s2) -> - compare (percent (topFunTicked s2) (topFunTotal s2)) - (percent (topFunTicked s1) (topFunTotal s1)) - - writeSummary index_alt $ \ (_,_,s1) (_,_,s2) -> - compare (percent (altTicked s2) (altTotal s2)) - (percent (altTicked s1) (altTotal s1)) - - writeSummary index_exp $ \ (_,_,s1) (_,_,s2) -> - compare (percent (expTicked s2) (expTotal s2)) - (percent (expTicked s1) (expTotal s1)) - - -markup_main _ [] - = hpcError markup_plugin $ "no .tix file or executable name specified" - --- Add characters to the left of a string until it is at least as --- large as requested. -padLeft :: Int -> Char -> String -> String -padLeft n c str = go n str - where - -- If the string is already long enough, stop traversing it. - go 0 _ = str - go k [] = replicate k c ++ str - go k (_:xs) = go (k-1) xs - -genHtmlFromMod - :: String - -> Flags - -> TixModule - -> Bool - -> Bool - -> IO (String, [Char], ModuleSummary) -genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do - let theHsPath = srcDirs flags - let modName0 = tixModuleName tix - - (Mix origFile _ _ tabStop mix') <- readMixWithFlags flags (Right tix) - - let arr_tix :: Array Int Integer - arr_tix = listArray (0,length (tixModuleTixs tix) - 1) - $ tixModuleTixs tix - - let tickedWith :: Int -> Integer - tickedWith n = arr_tix ! n - - isTicked n = tickedWith n /= 0 - - let info = [ (pos,theMarkup) - | (gid,(pos,boxLabel)) <- zip [0 ..] mix' - , let binBox = case (isTicked gid,isTicked (gid+1)) of - (False,False) -> [] - (True,False) -> [TickedOnlyTrue] - (False,True) -> [TickedOnlyFalse] - (True,True) -> [] - , let tickBox = if isTicked gid - then [IsTicked] - else [NotTicked] - , theMarkup <- case boxLabel of - ExpBox {} -> tickBox - TopLevelBox {} - -> TopLevelDecl theFunTotals (tickedWith gid) : tickBox - LocalBox {} -> tickBox - BinBox _ True -> binBox - _ -> [] - ] - - - let modSummary = foldr (.) id - [ \ st -> - case boxLabel of - ExpBox False - -> st { expTicked = ticked (expTicked st) - , expTotal = succ (expTotal st) - } - ExpBox True - -> st { expTicked = ticked (expTicked st) - , expTotal = succ (expTotal st) - , altTicked = ticked (altTicked st) - , altTotal = succ (altTotal st) - } - TopLevelBox _ -> - st { topFunTicked = ticked (topFunTicked st) - , topFunTotal = succ (topFunTotal st) - } - _ -> st - | (gid,(_pos,boxLabel)) <- zip [0 ..] mix' - , let ticked = if isTicked gid - then succ - else id - ] $ mempty - - -- add prefix to modName argument - content <- readFileFromPath (hpcError markup_plugin) origFile theHsPath - - let content' = markup tabStop info content - let addLine n xs = "" ++ padLeft 5 ' ' (show n) ++ " " ++ xs - let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines - let fileName = modName0 <.> "hs" <.> "html" - unless (verbosity flags < Normal) $ - putStrLn $ "Writing: " ++ fileName - writeFileUtf8 (dest_dir fileName) $ - unlines ["", - "", - "", - "", - "", - "", - "
",
-                     concat [
-                         "",
-                         "never executed ",
-                         "always true ",
-                         "always false"],
-                     "
", - "
"] ++ addLines content' ++ "\n
\n\n\n"; - - - modSummary `seq` return (modName0,fileName,modSummary) - -data Loc = Loc !Int !Int - deriving (Eq,Ord,Show) - -data Markup - = NotTicked - | TickedOnlyTrue - | TickedOnlyFalse - | IsTicked - | TopLevelDecl - Bool -- display entry totals - Integer - deriving (Eq,Show) - -markup :: Int -- ^tabStop - -> [(HpcPos,Markup)] -- random list of tick location pairs - -> String -- text to mark up - -> String -markup tabStop mix str = addMarkup tabStop str (Loc 1 1) [] sortedTickLocs - where - tickLocs = [ (Loc ln1 c1,Loc ln2 c2,mark) - | (pos,mark) <- mix - , let (ln1,c1,ln2,c2) = fromHpcPos pos - ] - sortedTickLocs = sortBy (\(locA1,locZ1,_) (locA2,locZ2,_) -> - (locA1,locZ2) `compare` (locA2,locZ1)) tickLocs - -addMarkup :: Int -- tabStop - -> String -- text to mark up - -> Loc -- current location - -> [(Loc,Markup)] -- stack of open ticks, with closing location - -> [(Loc,Loc,Markup)] -- sorted list of tick location pairs - -> String - --- check the pre-condition. ---addMarkup tabStop cs loc os ticks --- | not (isSorted (map fst os)) = error $ "addMarkup: bad closing ordering: " ++ show os - ---addMarkup tabStop cs loc os@(_:_) ticks --- | trace (show (loc,os,take 10 ticks)) False = undefined - --- close all open ticks, if we have reached the end -addMarkup _ [] _loc os [] = - concatMap (const closeTick) os -addMarkup tabStop cs loc ((o,_):os) ticks | loc > o = - closeTick ++ addMarkup tabStop cs loc os ticks - ---addMarkup tabStop cs loc os ((t1,t2,tik@(TopLevelDecl {})):ticks) | loc == t1 = --- openTick tik ++ closeTick ++ addMarkup tabStop cs loc os ticks - -addMarkup tabStop cs loc os ((t1,t2,tik0):ticks) | loc == t1 = - case os of - ((_,tik'):_) - | not (allowNesting tik0 tik') - -> addMarkup tabStop cs loc os ticks -- already marked or bool within marked bool - _ -> openTick tik0 ++ addMarkup tabStop cs loc (addTo (t2,tik0) os) ticks - where - - addTo (t,tik) [] = [(t,tik)] - addTo (t,tik) ((t',tik'):xs) | t <= t' = (t,tik):(t',tik'):xs - | otherwise = (t',tik):(t',tik'):xs - -addMarkup tabStop0 cs loc os ((t1,_t2,_tik):ticks) | loc > t1 = - -- throw away this tick, because it is from a previous place ?? - addMarkup tabStop0 cs loc os ticks - -addMarkup tabStop0 ('\n':cs) loc@(Loc ln col) os@((Loc ln2 col2,_):_) ticks - | ln == ln2 && col < col2 - = addMarkup tabStop0 (' ':'\n':cs) loc os ticks -addMarkup tabStop0 (c0:cs) loc@(Loc _ p) os ticks = - if c0=='\n' && os/=[] then - concatMap (const closeTick) (downToTopLevel os) ++ - c0 : "" ++ expand 1 w ++ "" ++ - concatMap (openTick.snd) (reverse (downToTopLevel os)) ++ - addMarkup tabStop0 cs' loc' os ticks - else if c0=='\t' then - expand p "\t" ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks - else - escape c0 ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks - where - (w,cs') = span (`elem` " \t") cs - loc' = foldl (flip incBy) loc (c0:w) - escape '>' = ">" - escape '<' = "<" - escape '"' = """ - escape '&' = "&" - escape c = [c] - - expand :: Int -> String -> String - expand _ "" = "" - expand c ('\t':s) = replicate (c' - c) ' ' ++ expand c' s - where - c' = tabStopAfter 8 c - expand c (' ':s) = ' ' : expand (c+1) s - expand _ _ = error "bad character in string for expansion" - - incBy :: Char -> Loc -> Loc - incBy '\n' (Loc ln _c) = Loc (succ ln) 1 - incBy '\t' (Loc ln c) = Loc ln (tabStopAfter tabStop0 c) - incBy _ (Loc ln c) = Loc ln (succ c) - - tabStopAfter :: Int -> Int -> Int - tabStopAfter tabStop c = fromJust (find (>c) [1,(tabStop + 1)..]) - - -addMarkup tabStop cs loc os ticks = "ERROR: " ++ show (take 10 cs,tabStop,loc,take 10 os,take 10 ticks) - -openTick :: Markup -> String -openTick NotTicked = "" -openTick IsTicked = "" -openTick TickedOnlyTrue = "" -openTick TickedOnlyFalse = "" -openTick (TopLevelDecl False _) = openTopDecl -openTick (TopLevelDecl True 0) - = "-- never entered" ++ - openTopDecl -openTick (TopLevelDecl True 1) - = "-- entered once" ++ - openTopDecl -openTick (TopLevelDecl True n0) - = "-- entered " ++ showBigNum n0 ++ " times" ++ openTopDecl - where showBigNum n | n <= 9999 = show n - | otherwise = case n `quotRem` 1000 of - (q, r) -> showBigNum' q ++ "," ++ showWith r - showBigNum' n | n <= 999 = show n - | otherwise = case n `quotRem` 1000 of - (q, r) -> showBigNum' q ++ "," ++ showWith r - showWith n = padLeft 3 '0' $ show n - - - -closeTick :: String -closeTick = "" - -openTopDecl :: String -openTopDecl = "" - -downToTopLevel :: [(Loc,Markup)] -> [(Loc,Markup)] -downToTopLevel ((_,TopLevelDecl {}):_) = [] -downToTopLevel (o : os) = o : downToTopLevel os -downToTopLevel [] = [] - - --- build in logic for nesting bin boxes - -allowNesting :: Markup -- innermost - -> Markup -- outermost - -> Bool -allowNesting n m | n == m = False -- no need to double nest -allowNesting IsTicked TickedOnlyFalse = False -allowNesting IsTicked TickedOnlyTrue = False -allowNesting _ _ = True - ------------------------------------------------------------------------------- - -data ModuleSummary = ModuleSummary - { expTicked :: !Int - , expTotal :: !Int - , topFunTicked :: !Int - , topFunTotal :: !Int - , altTicked :: !Int - , altTotal :: !Int - } - deriving (Show) - - -showModuleSummary :: (String, String, ModuleSummary) -> String -showModuleSummary (modName,fileName,modSummary) = - "\n" ++ - "  module " - ++ modName ++ "\n" ++ - showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++ - showSummary (altTicked modSummary) (altTotal modSummary) ++ - showSummary (expTicked modSummary) (expTotal modSummary) ++ - "\n" - -showTotalSummary :: ModuleSummary -> String -showTotalSummary modSummary = - "\n" ++ - "  Program Coverage Total\n" ++ - showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++ - showSummary (altTicked modSummary) (altTotal modSummary) ++ - showSummary (expTicked modSummary) (expTotal modSummary) ++ - "\n" - -showSummary :: (Integral t, Show t) => t -> t -> String -showSummary ticked total = - "" ++ showP (percent ticked total) ++ "" ++ - "" ++ show ticked ++ "/" ++ show total ++ "" ++ - "" ++ - (case percent ticked total of - Nothing -> " " - Just w -> bar w "bar" - ) ++ "" - where - showP Nothing = "- " - showP (Just x) = show x ++ "%" - bar 0 _ = bar 100 "invbar" - bar w inner = "" ++ - "
" ++ - "" ++ - "
" - -percent :: (Integral a) => a -> a -> Maybe a -percent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` total) - -instance Semi.Semigroup ModuleSummary where - (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1) <> (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2) - = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2) - -instance Monoid ModuleSummary where - mempty = ModuleSummary - { expTicked = 0 - , expTotal = 0 - , topFunTicked = 0 - , topFunTotal = 0 - , altTicked = 0 - , altTotal = 0 - } - mappend = (<>) - ------------------------------------------------------------------------------- --- global color palette - -red,green,yellow :: String -red = "#f20913" -green = "#60de51" -yellow = "yellow" ===================================== utils/hpc/HpcOverlay.hs deleted ===================================== @@ -1,157 +0,0 @@ -module HpcOverlay where - -import HpcFlags -import HpcParser -import HpcUtils -import Trace.Hpc.Tix -import Trace.Hpc.Mix -import Trace.Hpc.Util -import qualified Data.Map as Map -import Data.Tree - -overlay_options :: FlagOptSeq -overlay_options - = srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . outputOpt - . verbosityOpt - -overlay_plugin :: Plugin -overlay_plugin = Plugin { name = "overlay" - , usage = "[OPTION] .. [ [...]]" - , options = overlay_options - , summary = "Generate a .tix file from an overlay file" - , implementation = overlay_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -overlay_main :: Flags -> [String] -> IO () -overlay_main _ [] = hpcError overlay_plugin $ "no overlay file specified" -overlay_main flags files = do - specs <- mapM hpcParser files - let (Spec globals modules) = concatSpec specs - - let modules1 = Map.fromListWith (++) [ (m,info) | (m,info) <- modules ] - - mod_info <- - sequence [ do mix@(Mix origFile _ _ _ _) <- readMixWithFlags flags (Left modu) - content <- readFileFromPath (hpcError overlay_plugin) origFile (srcDirs flags) - processModule modu content mix mod_spec globals - | (modu, mod_spec) <- Map.toList modules1 - ] - - - let tix = Tix $ mod_info - - case outputFile flags of - "-" -> putStrLn (show tix) - out -> writeFile out (show tix) - - -processModule :: String -- ^ module name - -> String -- ^ module contents - -> Mix -- ^ mix entry for this module - -> [Tick] -- ^ local ticks - -> [ExprTick] -- ^ global ticks - -> IO TixModule -processModule modName modContents (Mix _ _ hash _ entries) locals globals = do - - let hsMap :: Map.Map Int String - hsMap = Map.fromList (zip [1..] $ lines modContents) - - let topLevelFunctions = - Map.fromListWith (++) - [ (nm,[pos]) - | (pos,TopLevelBox [nm]) <- entries - ] - - let inside :: HpcPos -> String -> Bool - inside pos nm = - case Map.lookup nm topLevelFunctions of - Nothing -> False - Just poss -> any (pos `insideHpcPos`) poss - - -- TODO: rename plzTick => plzExprTick, plzTopPick => plzTick - let plzTick :: HpcPos -> BoxLabel -> ExprTick -> Bool - plzTick pos (ExpBox _) (TickExpression _ match q _) = - qualifier pos q - && case match of - Nothing -> True - Just str -> str == grabHpcPos hsMap pos - plzTick _ _ _ = False - - - plzTopTick :: HpcPos -> BoxLabel -> Tick -> Bool - plzTopTick pos label (ExprTick ignore) = plzTick pos label ignore - plzTopTick pos _ (TickFunction fn q _) = - qualifier pos q && pos `inside` fn - plzTopTick pos label (InsideFunction fn igs) = - pos `inside` fn && any (plzTopTick pos label) igs - - - let tixs = Map.fromList - [ (ix, - any (plzTick pos label) globals - || any (plzTopTick pos label) locals) - | (ix,(pos,label)) <- zip [0..] entries - ] - - - -- let show' (srcspan,stuff) = show (srcspan,stuff,grabHpcPos hsMap span) - - let forest = createMixEntryDom - [ (srcspan,ix) - | ((srcspan,_),ix) <- zip entries [0..] - ] - - - -- - let forest2 = addParentToList [] $ forest --- putStrLn $ drawForest $ map (fmap show') $ forest2 - - let isDomList = Map.fromList - [ (ix,filter (/= ix) rng ++ dom) - | (_,(rng,dom)) <- concatMap flatten forest2 - , ix <- rng - ] - - -- We do not use laziness here, because the dominator lists - -- point to their equivent peers, creating loops. - - - let isTicked n = - case Map.lookup n tixs of - Just v -> v - Nothing -> error $ "can not find ix # " ++ show n - - let tixs' = [ case Map.lookup n isDomList of - Just vs -> if any isTicked (n : vs) then 1 else 0 - Nothing -> error $ "can not find ix in dom list # " ++ show n - | n <- [0..(length entries - 1)] - ] - - return $ TixModule modName hash (length tixs') tixs' - -qualifier :: HpcPos -> Maybe Qualifier -> Bool -qualifier _ Nothing = True -qualifier pos (Just (OnLine n)) = n == l1 && n == l2 - where (l1,_,l2,_) = fromHpcPos pos -qualifier pos (Just (AtPosition l1' c1' l2' c2')) - = (l1', c1', l2', c2') == fromHpcPos pos - -concatSpec :: [Spec] -> Spec -concatSpec = foldr - (\ (Spec pre1 body1) (Spec pre2 body2) - -> Spec (pre1 ++ pre2) (body1 ++ body2)) - (Spec [] []) - - - -addParentToTree :: [a] -> MixEntryDom [a] -> MixEntryDom ([a],[a]) -addParentToTree path (Node (pos,a) children) = - Node (pos,(a,path)) (addParentToList (a ++ path) children) - -addParentToList :: [a] -> [MixEntryDom [a]] -> [MixEntryDom ([a],[a])] -addParentToList path nodes = map (addParentToTree path) nodes ===================================== utils/hpc/HpcParser.y deleted ===================================== @@ -1,106 +0,0 @@ -{ -module HpcParser where - -import HpcLexer -} - -%name parser -%expect 0 -%tokentype { Token } - -%token - MODULE { ID "module" } - TICK { ID "tick" } - EXPRESSION { ID "expression" } - ON { ID "on" } - LINE { ID "line" } - POSITION { ID "position" } - FUNCTION { ID "function" } - INSIDE { ID "inside" } - AT { ID "at" } - ':' { SYM ':' } - '-' { SYM '-' } - ';' { SYM ';' } - '{' { SYM '{' } - '}' { SYM '}' } - int { INT $$ } - string { STR $$ } - cat { CAT $$ } -%% - -Spec :: { Spec } -Spec : Ticks Modules { Spec ($1 []) ($2 []) } - -Modules :: { L (ModuleName,[Tick]) } -Modules : Modules Module { $1 . ((:) $2) } - | { id } - -Module :: { (ModuleName,[Tick]) } -Module : MODULE string '{' TopTicks '}' - { ($2,$4 []) } - -TopTicks :: { L Tick } -TopTicks : TopTicks TopTick { $1 . ((:) $2) } - | { id } - -TopTick :: { Tick } -TopTick : Tick { ExprTick $1 } - | TICK FUNCTION string optQual optCat ';' - { TickFunction $3 $4 $5 } - | INSIDE string '{' TopTicks '}' - { InsideFunction $2 ($4 []) } - -Ticks :: { L ExprTick } -Ticks : Ticks Tick { $1 . ((:) $2) } - | { id } - -Tick :: { ExprTick } -Tick : TICK optString optQual optCat ';' - { TickExpression False $2 $3 $4 } - -optString :: { Maybe String } -optString : string { Just $1 } - | { Nothing } - -optQual :: { Maybe Qualifier } -optQual : ON LINE int { Just (OnLine $3) } - | AT POSITION int ':' int '-' int ':' int - { Just (AtPosition $3 $5 $7 $9) } - | { Nothing } -optCat :: { Maybe String } -optCat : cat { Just $1 } - | { Nothing } - -{ -type L a = [a] -> [a] - -type ModuleName = String - -data Spec - = Spec [ExprTick] [(ModuleName,[Tick])] - deriving (Show) - -data ExprTick - = TickExpression Bool (Maybe String) (Maybe Qualifier) (Maybe String) - deriving (Show) - -data Tick - = ExprTick ExprTick - | TickFunction String (Maybe Qualifier) (Maybe String) - | InsideFunction String [Tick] - deriving (Show) - -data Qualifier = OnLine Int - | AtPosition Int Int Int Int - deriving (Show) - - - -hpcParser :: String -> IO Spec -hpcParser filename = do - txt <- readFile filename - let tokens = initLexer txt - return $ parser tokens - -happyError e = error $ show (take 10 e) -} ===================================== utils/hpc/HpcReport.hs deleted ===================================== @@ -1,277 +0,0 @@ ---------------------------------------------------------- --- The main program for the hpc-report tool, part of HPC. --- Colin Runciman and Andy Gill, June 2006 ---------------------------------------------------------- - -module HpcReport (report_plugin) where - -import Prelude hiding (exp) -import Data.List(sort,intersperse,sortBy) -import HpcFlags -import Trace.Hpc.Mix -import Trace.Hpc.Tix -import Control.Monad hiding (guard) -import qualified Data.Set as Set - -notExpecting :: String -> a -notExpecting s = error ("not expecting "++s) - -data BoxTixCounts = BT {boxCount, tixCount :: !Int} - -btZero :: BoxTixCounts -btZero = BT {boxCount=0, tixCount=0} - -btPlus :: BoxTixCounts -> BoxTixCounts -> BoxTixCounts -btPlus (BT b1 t1) (BT b2 t2) = BT (b1+b2) (t1+t2) - -btPercentage :: String -> BoxTixCounts -> String -btPercentage s (BT b t) = showPercentage s t b - -showPercentage :: String -> Int -> Int -> String -showPercentage s 0 0 = "100% "++s++" (0/0)" -showPercentage s n d = showWidth 3 p++"% "++ - s++ - " ("++show n++"/"++show d++")" - where - p = (n*100) `div` d - showWidth w x0 = replicate (shortOf w (length sx)) ' ' ++ sx - where - sx = show x0 - shortOf x y = if y < x then x-y else 0 - -data BinBoxTixCounts = BBT { binBoxCount - , onlyTrueTixCount - , onlyFalseTixCount - , bothTixCount :: !Int} - -bbtzero :: BinBoxTixCounts -bbtzero = BBT { binBoxCount=0 - , onlyTrueTixCount=0 - , onlyFalseTixCount=0 - , bothTixCount=0} - -bbtPlus :: BinBoxTixCounts -> BinBoxTixCounts -> BinBoxTixCounts -bbtPlus (BBT b1 tt1 ft1 bt1) (BBT b2 tt2 ft2 bt2) = - BBT (b1+b2) (tt1+tt2) (ft1+ft2) (bt1+bt2) - -bbtPercentage :: String -> Bool -> BinBoxTixCounts -> String -bbtPercentage s withdetail (BBT b tt ft bt) = - showPercentage s bt b ++ - if withdetail && bt/=b then - detailFor tt "always True"++ - detailFor ft "always False"++ - detailFor (b-(tt+ft+bt)) "unevaluated" - else "" - where - detailFor n txt = if n>0 then ", "++show n++" "++txt - else "" - -data ModInfo = MI { exp,alt,top,loc :: !BoxTixCounts - , guard,cond,qual :: !BinBoxTixCounts - , decPaths :: [[String]]} - -miZero :: ModInfo -miZero = MI { exp=btZero - , alt=btZero - , top=btZero - , loc=btZero - , guard=bbtzero - , cond=bbtzero - , qual=bbtzero - , decPaths = []} - -miPlus :: ModInfo -> ModInfo -> ModInfo -miPlus mi1 mi2 = - MI { exp = exp mi1 `btPlus` exp mi2 - , alt = alt mi1 `btPlus` alt mi2 - , top = top mi1 `btPlus` top mi2 - , loc = loc mi1 `btPlus` loc mi2 - , guard = guard mi1 `bbtPlus` guard mi2 - , cond = cond mi1 `bbtPlus` cond mi2 - , qual = qual mi1 `bbtPlus` qual mi2 - , decPaths = decPaths mi1 ++ decPaths mi2 } - -allBinCounts :: ModInfo -> BinBoxTixCounts -allBinCounts mi = - BBT { binBoxCount = sumAll binBoxCount - , onlyTrueTixCount = sumAll onlyTrueTixCount - , onlyFalseTixCount = sumAll onlyFalseTixCount - , bothTixCount = sumAll bothTixCount } - where - sumAll f = f (guard mi) + f (cond mi) + f (qual mi) - -accumCounts :: [(BoxLabel,Integer)] -> ModInfo -> ModInfo -accumCounts [] mi = mi -accumCounts ((bl,btc):etc) mi - | single bl = accumCounts etc mi' - where - mi' = case bl of - ExpBox False -> mi{exp = inc (exp mi)} - ExpBox True -> mi{exp = inc (exp mi), alt = inc (alt mi)} - TopLevelBox dp -> mi{top = inc (top mi) - ,decPaths = upd dp (decPaths mi)} - LocalBox dp -> mi{loc = inc (loc mi) - ,decPaths = upd dp (decPaths mi)} - _other -> notExpecting "BoxLabel in accumcounts" - inc (BT {boxCount=bc,tixCount=tc}) = - BT { boxCount = bc+1 - , tixCount = tc + bit (btc>0) } - upd dp dps = - if btc>0 then dps else dp:dps -accumCounts [_] _ = error "accumCounts: Unhandled case: [_] _" -accumCounts ((bl0,btc0):(bl1,btc1):etc) mi = - accumCounts etc mi' - where - mi' = case (bl0,bl1) of - (BinBox GuardBinBox True, BinBox GuardBinBox False) -> - mi{guard = inc (guard mi)} - (BinBox CondBinBox True, BinBox CondBinBox False) -> - mi{cond = inc (cond mi)} - (BinBox QualBinBox True, BinBox QualBinBox False) -> - mi{qual = inc (qual mi)} - _other -> notExpecting "BoxLabel pair in accumcounts" - inc (BBT { binBoxCount=bbc - , onlyTrueTixCount=ttc - , onlyFalseTixCount=ftc - , bothTixCount=btc}) = - BBT { binBoxCount = bbc+1 - , onlyTrueTixCount = ttc + bit (btc0 >0 && btc1==0) - , onlyFalseTixCount = ftc + bit (btc0==0 && btc1 >0) - , bothTixCount = btc + bit (btc0 >0 && btc1 >0) } - -bit :: Bool -> Int -bit True = 1 -bit False = 0 - -single :: BoxLabel -> Bool -single (ExpBox {}) = True -single (TopLevelBox _) = True -single (LocalBox _) = True -single (BinBox {}) = False - -modInfo :: Flags -> Bool -> TixModule -> IO ModInfo -modInfo hpcflags qualDecList tix@(TixModule moduleName _ _ tickCounts) = do - Mix _ _ _ _ mes <- readMixWithFlags hpcflags (Right tix) - return (q (accumCounts (zip (map snd mes) tickCounts) miZero)) - where - q mi = if qualDecList then mi{decPaths = map (moduleName:) (decPaths mi)} - else mi - -modReport :: Flags -> TixModule -> IO () -modReport hpcflags tix@(TixModule moduleName _ _ _) = do - mi <- modInfo hpcflags False tix - if xmlOutput hpcflags - then putStrLn $ " " - else putStrLn ("----------") - printModInfo hpcflags mi - if xmlOutput hpcflags - then putStrLn $ " " - else return () - -printModInfo :: Flags -> ModInfo -> IO () -printModInfo hpcflags mi | xmlOutput hpcflags = do - element "exprs" (xmlBT $ exp mi) - element "booleans" (xmlBBT $ allBinCounts mi) - element "guards" (xmlBBT $ guard mi) - element "conditionals" (xmlBBT $ cond mi) - element "qualifiers" (xmlBBT $ qual mi) - element "alts" (xmlBT $ alt mi) - element "local" (xmlBT $ loc mi) - element "toplevel" (xmlBT $ top mi) -printModInfo hpcflags mi = do - putStrLn (btPercentage "expressions used" (exp mi)) - putStrLn (bbtPercentage "boolean coverage" False (allBinCounts mi)) - putStrLn (" "++bbtPercentage "guards" True (guard mi)) - putStrLn (" "++bbtPercentage "'if' conditions" True (cond mi)) - putStrLn (" "++bbtPercentage "qualifiers" True (qual mi)) - putStrLn (btPercentage "alternatives used" (alt mi)) - putStrLn (btPercentage "local declarations used" (loc mi)) - putStrLn (btPercentage "top-level declarations used" (top mi)) - modDecList hpcflags mi - -modDecList :: Flags -> ModInfo -> IO () -modDecList hpcflags mi0 = - when (decList hpcflags && someDecsUnused mi0) $ do - putStrLn "unused declarations:" - mapM_ showDecPath (sort (decPaths mi0)) - where - someDecsUnused mi = tixCount (top mi) < boxCount (top mi) || - tixCount (loc mi) < boxCount (loc mi) - showDecPath dp = putStrLn (" "++ - concat (intersperse "." dp)) - -report_plugin :: Plugin -report_plugin = Plugin { name = "report" - , usage = "[OPTION] .. [ [ ..]]" - , options = report_options - , summary = "Output textual report about program coverage" - , implementation = report_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -report_main :: Flags -> [String] -> IO () -report_main hpcflags (progName:mods) = do - let hpcflags1 = hpcflags - { includeMods = Set.fromList mods - `Set.union` - includeMods hpcflags } - let prog = getTixFileName $ progName - tix <- readTix prog - case tix of - Just (Tix tickCounts) -> - makeReport hpcflags1 progName - $ sortBy (\ mod1 mod2 -> tixModuleName mod1 `compare` tixModuleName mod2) - $ [ tix' - | tix'@(TixModule m _ _ _) <- tickCounts - , allowModule hpcflags1 m - ] - Nothing -> hpcError report_plugin $ "unable to find tix file for:" ++ progName -report_main _ [] = - hpcError report_plugin $ "no .tix file or executable name specified" - -makeReport :: Flags -> String -> [TixModule] -> IO () -makeReport hpcflags progName modTcs | xmlOutput hpcflags = do - putStrLn $ "" - putStrLn $ "" - if perModule hpcflags - then mapM_ (modReport hpcflags) modTcs - else return () - mis <- mapM (modInfo hpcflags True) modTcs - putStrLn $ " " - printModInfo hpcflags (foldr miPlus miZero mis) - putStrLn $ " " - putStrLn $ "" -makeReport hpcflags _ modTcs = - if perModule hpcflags then - mapM_ (modReport hpcflags) modTcs - else do - mis <- mapM (modInfo hpcflags True) modTcs - printModInfo hpcflags (foldr miPlus miZero mis) - -element :: String -> [(String,String)] -> IO () -element tag attrs = putStrLn $ - " <" ++ tag ++ " " - ++ unwords [ x ++ "=" ++ show y - | (x,y) <- attrs - ] ++ "/>" - -xmlBT :: BoxTixCounts -> [(String, String)] -xmlBT (BT b t) = [("boxes",show b),("count",show t)] - -xmlBBT :: BinBoxTixCounts -> [(String, String)] -xmlBBT (BBT b tt tf bt) = [("boxes",show b),("true",show tt),("false",show tf),("count",show (tt + tf + bt))] - ------------------------------------------------------------------------------- - -report_options :: FlagOptSeq -report_options - = perModuleOpt - . decListOpt - . excludeOpt - . includeOpt - . srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . xmlOutputOpt - . verbosityOpt ===================================== utils/hpc/HpcShowTix.hs deleted ===================================== @@ -1,63 +0,0 @@ -module HpcShowTix (showtix_plugin) where - -import Trace.Hpc.Mix -import Trace.Hpc.Tix - -import HpcFlags - -import qualified Data.Set as Set - -showtix_options :: FlagOptSeq -showtix_options - = excludeOpt - . includeOpt - . srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . outputOpt - . verbosityOpt - -showtix_plugin :: Plugin -showtix_plugin = Plugin { name = "show" - , usage = "[OPTION] .. [ [ ..]]" - , options = showtix_options - , summary = "Show .tix file in readable, verbose format" - , implementation = showtix_main - , init_flags = default_flags - , final_flags = default_final_flags - } - - -showtix_main :: Flags -> [String] -> IO () -showtix_main _ [] = hpcError showtix_plugin $ "no .tix file or executable name specified" -showtix_main flags (prog:modNames) = do - let hpcflags1 = flags - { includeMods = Set.fromList modNames - `Set.union` - includeMods flags } - - optTixs <- readTix (getTixFileName prog) - case optTixs of - Nothing -> hpcError showtix_plugin $ "could not read .tix file : " ++ prog - Just (Tix tixs) -> do - tixs_mixs <- sequence - [ do mix <- readMixWithFlags hpcflags1 (Right tix) - return $ (tix,mix) - | tix <- tixs - , allowModule hpcflags1 (tixModuleName tix) - ] - - let rjust n str = take (n - length str) (repeat ' ') ++ str - let ljust n str = str ++ take (n - length str) (repeat ' ') - - sequence_ [ sequence_ [ putStrLn (rjust 5 (show ix) ++ " " ++ - rjust 10 (show count) ++ " " ++ - ljust 20 modName ++ " " ++ rjust 20 (show pos) ++ " " ++ show lab) - | (count,ix,(pos,lab)) <- zip3 tixs' [(0::Int)..] entries - ] - | ( TixModule modName _hash1 _ tixs' - , Mix _file _timestamp _hash2 _tab entries - ) <- tixs_mixs - ] - - return () ===================================== utils/hpc/HpcUtils.hs deleted ===================================== @@ -1,37 +0,0 @@ -module HpcUtils where - -import Trace.Hpc.Util (catchIO, HpcPos, fromHpcPos, readFileUtf8) -import qualified Data.Map as Map -import System.FilePath - -dropWhileEndLE :: (a -> Bool) -> [a] -> [a] --- Spec: dropWhileEndLE p = reverse . dropWhile p . reverse -dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x:r) [] - --- turns \n into ' ' --- | grab's the text behind a HpcPos; -grabHpcPos :: Map.Map Int String -> HpcPos -> String -grabHpcPos hsMap srcspan = - case lns of - [] -> error "grabHpcPos: invalid source span" - [ln] -> (take ((c2 - c1) + 1) $ drop (c1 - 1) ln) - hd : tl -> - let lns1 = drop (c1 -1) hd : tl - lns2 = init lns1 ++ [take (c2 + 1) (last lns1) ] - in foldl1 (\ xs ys -> xs ++ "\n" ++ ys) lns2 - where (l1,c1,l2,c2) = fromHpcPos srcspan - lns = map (\ n -> case Map.lookup n hsMap of - Just ln -> ln - Nothing -> error $ "bad line number : " ++ show n - ) [l1..l2] - - -readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String -readFileFromPath _ filename@('/':_) _ = readFileUtf8 filename -readFileFromPath err filename path0 = readTheFile path0 - where - readTheFile [] = err $ "could not find " ++ show filename - ++ " in path " ++ show path0 - readTheFile (dir:dirs) = - catchIO (readFileUtf8 (dir filename)) - (\ _ -> readTheFile dirs) ===================================== utils/hpc/Main.hs deleted ===================================== @@ -1,217 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables, TupleSections #-} --- (c) 2007 Andy Gill - --- Main driver for Hpc -import Control.Monad (forM, forM_, when) -import Data.Bifunctor (bimap) -import Data.List (intercalate, partition, uncons) -import Data.List.NonEmpty (NonEmpty((:|))) -import Data.Maybe (catMaybes, isJust) -import Data.Version -import System.Environment -import System.Exit -import System.Console.GetOpt -import System.Directory (doesPathExist) - -import HpcFlags -import HpcReport -import HpcMarkup -import HpcCombine -import HpcShowTix -import HpcDraft -import HpcOverlay -import Paths_hpc_bin - -helpList :: IO () -helpList = do - putStrLn $ - "Usage: hpc COMMAND ...\n\n" ++ - section "Commands" help ++ - section "Reporting Coverage" reporting ++ - section "Processing Coverage files" processing ++ - section "Coverage Overlays" overlays ++ - section "Others" other ++ - "" - putStrLn "" - putStrLn "or: hpc @response_file_1 @response_file_2 ..." - putStrLn "" - putStrLn "The contents of a Response File must have this format:" - putStrLn "COMMAND ..." - putStrLn "" - putStrLn "example:" - putStrLn "report my_library.tix --include=ModuleA \\" - putStrLn "--include=ModuleB" - where - help = ["help"] - reporting = ["report","markup"] - overlays = ["overlay","draft"] - processing = ["sum","combine","map"] - other = [ name hook - | hook <- hooks - , name hook `notElem` - (concat [help,reporting,processing,overlays]) - ] - -section :: String -> [String] -> String -section _ [] = "" -section msg cmds = msg ++ ":\n" - ++ unlines [ take 14 (" " ++ cmd ++ repeat ' ') ++ summary hook - | cmd <- cmds - , hook <- hooks - , name hook == cmd - ] - -dispatch :: [String] -> IO () -dispatch [] = do - helpList - exitWith ExitSuccess -dispatch (txt:args0) = do - case lookup txt hooks' of - Just plugin -> parse plugin args0 - _ -> case getResponseFileName txt of - Nothing -> parse help_plugin (txt:args0) - Just firstResponseFileName -> do - let - (responseFileNames', nonResponseFileNames) = partitionFileNames args0 - -- if arguments are combination of Response Files and non-Response Files, exit with error - when (length nonResponseFileNames > 0) $ do - let - putStrLn $ "First argument '" <> txt <> "' is a Response File, " <> - "followed by non-Response File(s): '" <> intercalate "', '" nonResponseFileNames <> "'" - putStrLn $ "When first argument is a Response File, " <> - "all arguments should be Response Files." - exitFailure - let - responseFileNames :: NonEmpty FilePath - responseFileNames = firstResponseFileName :| responseFileNames' - - forM_ responseFileNames $ \responseFileName -> do - exists <- doesPathExist responseFileName - when (not exists) $ do - putStrLn $ "Response File '" <> responseFileName <> "' does not exist" - exitFailure - - -- read all Response Files - responseFileNamesAndText :: NonEmpty (FilePath, String) <- - forM responseFileNames $ \responseFileName -> - fmap (responseFileName, ) (readFile responseFileName) - forM_ responseFileNamesAndText $ \(responseFileName, responseFileText) -> - -- parse first word of Response File, which should be a command - case uncons $ words responseFileText of - Nothing -> do - putStrLn $ "Response File '" <> responseFileName <> "' has no command" - exitFailure - Just (responseFileCommand, args1) -> case lookup responseFileCommand hooks' of - -- check command for validity - -- It is important than a Response File cannot specify another Response File; - -- this is prevented - Nothing -> do - putStrLn $ "Response File '" <> responseFileName <> - "' command '" <> responseFileCommand <> "' invalid" - exitFailure - Just plugin -> do - putStrLn $ "Response File '" <> responseFileName <> "':" - parse plugin args1 - - where - getResponseFileName :: String -> Maybe FilePath - getResponseFileName s = do - (firstChar, filename) <- uncons s - if firstChar == '@' - then pure filename - else Nothing - - -- first member of tuple is list of Response File names, - -- second member of tuple is list of all other arguments - partitionFileNames :: [String] -> ([FilePath], [String]) - partitionFileNames xs = let - hasFileName :: [(String, Maybe FilePath)] - hasFileName = fmap (\x -> (x, getResponseFileName x)) xs - (fileNames, nonFileNames) :: ([Maybe FilePath], [String]) = - bimap (fmap snd) (fmap fst) $ partition (isJust . snd) hasFileName - in (catMaybes fileNames, nonFileNames) - - parse plugin args = - case getOpt Permute (options plugin []) args of - (_,_,errs) | not (null errs) - -> do putStrLn "hpc failed:" - sequence_ [ putStr (" " ++ err) - | err <- errs - ] - putStrLn $ "\n" - command_usage plugin - exitFailure - (o,ns,_) -> do - let flags = final_flags plugin - . foldr (.) id o - $ init_flags plugin - implementation plugin flags ns - -main :: IO () -main = do - args <- getArgs - dispatch args - ------------------------------------------------------------------------------- - -hooks :: [Plugin] -hooks = [ help_plugin - , report_plugin - , markup_plugin - , sum_plugin - , combine_plugin - , map_plugin - , showtix_plugin - , overlay_plugin - , draft_plugin - , version_plugin - ] - -hooks' :: [(String, Plugin)] -hooks' = [ (name hook,hook) | hook <- hooks ] - ------------------------------------------------------------------------------- - -help_plugin :: Plugin -help_plugin = Plugin { name = "help" - , usage = "[]" - , summary = "Display help for hpc or a single command" - , options = help_options - , implementation = help_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -help_main :: Flags -> [String] -> IO () -help_main _ [] = do - helpList - exitWith ExitSuccess -help_main _ (sub_txt:_) = do - case lookup sub_txt hooks' of - Nothing -> do - putStrLn $ "no such HPC command: " <> sub_txt - exitFailure - Just plugin' -> do - command_usage plugin' - exitWith ExitSuccess - -help_options :: FlagOptSeq -help_options = id - ------------------------------------------------------------------------------- - -version_plugin :: Plugin -version_plugin = Plugin { name = "version" - , usage = "" - , summary = "Display version for hpc" - , options = id - , implementation = version_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -version_main :: Flags -> [String] -> IO () -version_main _ _ = putStrLn ("hpc tools, version " ++ showVersion version) - - ------------------------------------------------------------------------------- ===================================== utils/hpc/Makefile deleted ===================================== @@ -1,15 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -dir = utils/hpc -TOP = ../.. -include $(TOP)/mk/sub-makefile.mk ===================================== utils/hpc/hpc-bin.cabal deleted ===================================== @@ -1,44 +0,0 @@ -Name: hpc-bin --- XXX version number: -Version: 0.68 -Copyright: XXX -License: BSD3 --- XXX License-File: LICENSE -Author: XXX -Maintainer: XXX -Synopsis: XXX -Description: XXX -Category: Development -build-type: Simple -cabal-version: 2.0 - -Flag build-tool-depends - Description: Use build-tool-depends - Default: True - -Executable hpc - Default-Language: Haskell2010 - Main-Is: Main.hs - Other-Modules: HpcParser - HpcCombine - HpcDraft - HpcFlags - HpcLexer - HpcMarkup - HpcOverlay - HpcReport - HpcShowTix - HpcUtils - Paths_hpc_bin - - autogen-modules: Paths_hpc_bin - - Build-Depends: base >= 4 && < 5, - directory >= 1 && < 1.4, - filepath >= 1 && < 1.5, - containers >= 0.1 && < 0.7, - array >= 0.1 && < 0.6, - hpc >= 0.6.1 && < 0.7 - - if flag(build-tool-depends) - build-tool-depends: happy:happy >= 1.20.0 ===================================== utils/hpc/hpc.wrapper deleted ===================================== @@ -1,2 +0,0 @@ -#!/bin/sh -exec "$executablename" ${1+"$@"} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2aa0770845631e4355f55694f49b3e4b66ecf751...606793d424b08971f1eea4f1fae84b89297e1e63 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2aa0770845631e4355f55694f49b3e4b66ecf751...606793d424b08971f1eea4f1fae84b89297e1e63 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 06:25:15 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Mar 2023 01:25:15 -0500 Subject: [Git][ghc/ghc][master] linker: fix linking with aligned sections (#23066) Message-ID: <64082a4bdde21_2c78e9158dd0f0365277@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 5 changed files: - rts/linker/Elf.c - testsuite/tests/rts/linker/Makefile - + testsuite/tests/rts/linker/T23066.stdout - + testsuite/tests/rts/linker/T23066_c.c - testsuite/tests/rts/linker/all.T Changes: ===================================== rts/linker/Elf.c ===================================== @@ -872,12 +872,14 @@ ocGetNames_ELF ( ObjectCode* oc ) else if (!oc->imageMapped || size < getPageSize() / 3) { bool executable = kind == SECTIONKIND_CODE_OR_RODATA; m32_allocator *allocator = executable ? oc->rx_m32 : oc->rw_m32; - // align on 16 bytes. The reason being that llvm will emit see - // paddq statements for x86_64 under optimisation and load from - // RODATA sections. Specifically .rodata.cst16. However we don't - // handle the cst part in any way what so ever, so 16 seems - // better than 8. - start = m32_alloc(allocator, size, 16); + // Correctly align the section. This is particularly important for + // the alignment of .rodata.cstNN sections. + // + // llvm will emit see paddq statements for x86_64 under + // optimisation and load from RODATA sections, specifically + // .rodata.cst16. Also we may encounter .rodata.cst32 sections + // in objects using AVX instructions (see #23066). + start = m32_alloc(allocator, size, align); if (start == NULL) goto fail; memcpy(start, oc->image + offset, size); alloc = SECTION_M32; ===================================== testsuite/tests/rts/linker/Makefile ===================================== @@ -12,6 +12,11 @@ section_alignment: '$(TEST_HC)' $(TEST_HC_OPTS_NO_RTSOPTS) -v0 --make -no-rtsopts-suggestions -no-hs-main -o runner runner.c ./runner section_alignment.o isAligned +T23066: + '$(TEST_CC)' $(TEST_CC_OPTS) -c -o T23066_c.o T23066_c.c + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RTSOPTS) -v0 --make -no-rtsopts-suggestions -no-hs-main -o runner runner.c -static + ./runner T23066_c.o isAligned + T2615-prep: $(RM) libfoo_T2615.so '$(TEST_HC)' $(TEST_HC_OPTS) -fPIC -c libfoo_T2615.c -o libfoo_T2615.o ===================================== testsuite/tests/rts/linker/T23066.stdout ===================================== @@ -0,0 +1,2 @@ +Linking: path = T23066_c.o, symname = isAligned +1 ===================================== testsuite/tests/rts/linker/T23066_c.c ===================================== @@ -0,0 +1,42 @@ +#include +#include + +extern int foo32_1, foo32_2; + +// The bug in #23066 was that we wouldn't correctly align 32-bytes aligned +// sections, except by chance (we were always aligning on 16 bytes). +// +// Hence we intersperse two 16-bytes aligned sections with two 32-bytes aligned +// sections to ensure that at least one of the 32-bytes aligned section +// triggers the bug (the order of the sections seems to be preserved). + +__asm__( +" .section pad16_1,\"aM\", at progbits,16\n\t" +" .align 16\n\t" +" .byte 0\n\t" +"\n\t" +" .global foo32_1\n\t" +" .section sfoo32_1,\"aM\", at progbits,32\n\t" +" .align 32\n\t" +"foo32_1:\n\t" +" .byte 0\n\t" +"\n\t" +" .section pad16_2,\"aM\", at progbits,16\n\t" +" .align 16\n\t" +" .byte 0\n\t" +"\n\t" +" .global foo32_2\n\t" +" .section sfoo32_2,\"aM\", at progbits,32\n\t" +" .align 32\n\t" +"foo32_2:\n\t" +" .byte 0\n\t" +); + + +#define ALIGN32(x) (((intptr_t)(&x) & 0x1F) == 0) + +int isAligned() { + //printf("%p\n", &foo32_1); + //printf("%p\n", &foo32_2); + return (ALIGN32(foo32_1) && ALIGN32(foo32_2)); +} ===================================== testsuite/tests/rts/linker/all.T ===================================== @@ -16,6 +16,14 @@ test('section_alignment', ], makefile_test, []) +###################################### +test('T23066', + [ unless(arch('x86_64'), skip) + , unless(opsys('linux'), skip) + , extra_files(['runner.c', 'T23066_c.c']) + ], + makefile_test, []) + ###################################### # Test to see if linker scripts link properly to real ELF files test('T2615', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4158722a6cff5d19e228356c525946b6c4b83396 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4158722a6cff5d19e228356c525946b6c4b83396 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 11:29:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Mar 2023 06:29:27 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Remove utils/hpc subdirectory and its contents Message-ID: <640871972f769_2c78e91ade235c4247c1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - f9c23813 by Greg Steuck at 2023-03-08T06:28:54-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - b1409663 by Alexis King at 2023-03-08T06:28:56-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 28 changed files: - .gitmodules - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/StgToByteCode.hs - hadrian/src/Oracles/Setting.hs - rts/linker/Elf.c - + testsuite/tests/bytecode/T23068.hs - + testsuite/tests/bytecode/T23068.script - + testsuite/tests/bytecode/T23068.stdout - + testsuite/tests/bytecode/all.T - testsuite/tests/rts/linker/Makefile - + testsuite/tests/rts/linker/T23066.stdout - + testsuite/tests/rts/linker/T23066_c.c - testsuite/tests/rts/linker/all.T - + utils/hpc - − utils/hpc/HpcCombine.hs - − utils/hpc/HpcDraft.hs - − utils/hpc/HpcFlags.hs - − utils/hpc/HpcLexer.hs - − utils/hpc/HpcMarkup.hs - − utils/hpc/HpcOverlay.hs - − utils/hpc/HpcParser.y - − utils/hpc/HpcReport.hs - − utils/hpc/HpcShowTix.hs - − utils/hpc/HpcUtils.hs - − utils/hpc/Main.hs - − utils/hpc/Makefile - − utils/hpc/hpc-bin.cabal - − utils/hpc/hpc.wrapper Changes: ===================================== .gitmodules ===================================== @@ -110,3 +110,6 @@ [submodule "libraries/exceptions"] path = libraries/exceptions url = https://gitlab.haskell.org/ghc/packages/exceptions.git +[submodule "utils/hpc"] + path = utils/hpc + url = https://gitlab.haskell.org/hpc/hpc-bin.git ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -funbox-strict-fields #-} -- -- (c) The University of Glasgow 2002-2006 @@ -354,7 +355,10 @@ instance Outputable BCInstr where ppr RETURN = text "RETURN" ppr (RETURN_UNLIFTED pk) = text "RETURN_UNLIFTED " <+> ppr pk ppr (RETURN_TUPLE) = text "RETURN_TUPLE" - ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> ppr uniq <+> text "" + ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> mb_uniq <+> text "" + where mb_uniq = sdocOption sdocSuppressUniques $ \case + True -> text "" + False -> ppr uniq ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -486,8 +486,7 @@ returnUnliftedReps d s szb reps = do -- otherwise use RETURN_TUPLE with a tuple descriptor nv_reps -> do let (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 (primRepCmmType platform) nv_reps - args_ptrs = map (\(rep, off) -> (isFollowableArg (toArgRep platform rep), off)) args_offsets - tuple_bco <- emitBc (tupleBCO platform call_info args_ptrs) + tuple_bco <- emitBc (tupleBCO platform call_info args_offsets) return $ PUSH_UBX (mkNativeCallInfoLit platform call_info) 1 `consOL` PUSH_BCO tuple_bco `consOL` unitOL RETURN_TUPLE @@ -1050,13 +1049,9 @@ doCase d s p scrut bndr alts p scrut alt_bco' <- emitBc alt_bco if ubx_tuple_frame - then do - let args_ptrs = - map (\(rep, off) -> (isFollowableArg (toArgRep platform rep), off)) - args_offsets - tuple_bco <- emitBc (tupleBCO platform call_info args_ptrs) - return (PUSH_ALTS_TUPLE alt_bco' call_info tuple_bco - `consOL` scrut_code) + then do tuple_bco <- emitBc (tupleBCO platform call_info args_offsets) + return (PUSH_ALTS_TUPLE alt_bco' call_info tuple_bco + `consOL` scrut_code) else let push_alts | not ubx_frame = PUSH_ALTS alt_bco' @@ -1244,11 +1239,10 @@ usePlainReturn t -} -tupleBCO :: Platform -> NativeCallInfo -> [(Bool, ByteOff)] -> [FFIInfo] -> ProtoBCO Name -tupleBCO platform info pointers = +tupleBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name +tupleBCO platform args_info args = mkProtoBCO platform invented_name body_code (Left []) 0{-no arity-} bitmap_size bitmap False{-is alts-} - where {- The tuple BCO is never referred to by name, so we can get away @@ -1260,18 +1254,16 @@ tupleBCO platform info pointers = -- the first word in the frame is the call_info word, -- which is not a pointer - bitmap_size = trunc16W $ 1 + nativeCallSize info - bitmap = intsToReverseBitmap platform (fromIntegral bitmap_size) $ - map ((+1) . fromIntegral . bytesToWords platform . snd) - (filter fst pointers) + nptrs_prefix = 1 + (bitmap_size, bitmap) = mkStackBitmap platform nptrs_prefix args_info args + body_code = mkSlideW 0 1 -- pop frame header `snocOL` RETURN_TUPLE -- and add it again -primCallBCO :: Platform -> NativeCallInfo -> [(Bool, ByteOff)] -> [FFIInfo] -> ProtoBCO Name -primCallBCO platform args_info pointers = +primCallBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name +primCallBCO platform args_info args = mkProtoBCO platform invented_name body_code (Left []) 0{-no arity-} bitmap_size bitmap False{-is alts-} - where {- The primcall BCO is never referred to by name, so we can get away @@ -1281,20 +1273,52 @@ primCallBCO platform args_info pointers = -} invented_name = mkSystemVarName (mkPseudoUniqueE 0) (fsLit "primcall") - -- the first three words in the frame are the BCO describing the - -- pointers in the frame, the call_info word and the pointer - -- to the Cmm function being called. None of these is a pointer that - -- should be followed by the garbage collector - bitmap_size = trunc16W $ 2 + nativeCallSize args_info - bitmap = intsToReverseBitmap platform (fromIntegral bitmap_size) $ - map ((+2) . fromIntegral . bytesToWords platform . snd) - (filter fst pointers) + -- The first two words in the frame (after the BCO) are the call_info word + -- and the pointer to the Cmm function being called. Neither of these is a + -- pointer that should be followed by the garbage collector. + nptrs_prefix = 2 + (bitmap_size, bitmap) = mkStackBitmap platform nptrs_prefix args_info args + -- if the primcall BCO is ever run it's a bug, since the BCO should only -- be pushed immediately before running the PRIMCALL bytecode instruction, -- which immediately leaves the interpreter to jump to the stg_primcall_info -- Cmm function body_code = unitOL CASEFAIL +-- | Builds a bitmap for a stack layout with a nonpointer prefix followed by +-- some number of arguments. +mkStackBitmap + :: Platform + -> WordOff + -- ^ The number of nonpointer words that prefix the arguments. + -> NativeCallInfo + -> [(PrimRep, ByteOff)] + -- ^ The stack layout of the arguments, where each offset is relative to the + -- /bottom/ of the stack space they occupy. Their offsets must be word-aligned, + -- and the list must be sorted in order of ascending offset (i.e. bottom to top). + -> (Word16, [StgWord]) +mkStackBitmap platform nptrs_prefix args_info args + = (bitmap_size, bitmap) + where + bitmap_size = trunc16W $ nptrs_prefix + arg_bottom + bitmap = intsToReverseBitmap platform (fromIntegral bitmap_size) ptr_offsets + + arg_bottom = nativeCallSize args_info + ptr_offsets = reverse $ map (fromIntegral . convert_arg_offset) + $ mapMaybe get_ptr_offset args + + get_ptr_offset :: (PrimRep, ByteOff) -> Maybe ByteOff + get_ptr_offset (rep, byte_offset) + | isFollowableArg (toArgRep platform rep) = Just byte_offset + | otherwise = Nothing + + convert_arg_offset :: ByteOff -> WordOff + convert_arg_offset arg_offset = + -- The argument offsets are relative to `arg_bottom`, but + -- `intsToReverseBitmap` expects offsets from the top, so we need to flip + -- them around. + nptrs_prefix + (arg_bottom - bytesToWords platform arg_offset) + -- ----------------------------------------------------------------------------- -- Deal with a primitive call to native code. @@ -1322,15 +1346,12 @@ generatePrimCall d s p target _mb_unit _result_ty args (args_info, args_offsets) = layoutNativeCall profile NativePrimCall - d + 0 (primRepCmmType platform . argPrimRep) nv_args - args_ptrs :: [(Bool, ByteOff)] - args_ptrs = - map (\(r, off) -> - (isFollowableArg (toArgRep platform . argPrimRep $ r), off)) - args_offsets + prim_args_offsets = mapFst argPrimRep args_offsets + shifted_args_offsets = mapSnd (+ d) args_offsets push_target = PUSH_UBX (LitLabel target Nothing IsFunction) 1 push_info = PUSH_UBX (mkNativeCallInfoLit platform args_info) 1 @@ -1347,8 +1368,8 @@ generatePrimCall d s p target _mb_unit _result_ty args go !dd pushes ((a, off):cs) = do (push, szb) <- pushAtom dd p a massert (off == dd + szb) go (dd + szb) (push:pushes) cs - push_args <- go d [] args_offsets - args_bco <- emitBc (primCallBCO platform args_info args_ptrs) + push_args <- go d [] shifted_args_offsets + args_bco <- emitBc (primCallBCO platform args_info prim_args_offsets) return $ mconcat push_args `appOL` (push_target `consOL` push_info `consOL` ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -293,7 +293,10 @@ isElfTarget = anyTargetOs elfOSes -- TODO: Windows supports lazy binding (but GHC doesn't currently support -- dynamic way on Windows anyways). hostSupportsRPaths :: Action Bool -hostSupportsRPaths = anyHostOs (elfOSes ++ machoOSes) +hostSupportsRPaths = do + -- https://gitlab.haskell.org/ghc/ghc/-/issues/23011 + isOpenBSD <- anyHostOs ["openbsd"] + if not isOpenBSD then anyHostOs (elfOSes ++ machoOSes) else pure False -- | Check whether the target supports GHCi. ghcWithInterpreter :: Action Bool ===================================== rts/linker/Elf.c ===================================== @@ -872,12 +872,14 @@ ocGetNames_ELF ( ObjectCode* oc ) else if (!oc->imageMapped || size < getPageSize() / 3) { bool executable = kind == SECTIONKIND_CODE_OR_RODATA; m32_allocator *allocator = executable ? oc->rx_m32 : oc->rw_m32; - // align on 16 bytes. The reason being that llvm will emit see - // paddq statements for x86_64 under optimisation and load from - // RODATA sections. Specifically .rodata.cst16. However we don't - // handle the cst part in any way what so ever, so 16 seems - // better than 8. - start = m32_alloc(allocator, size, 16); + // Correctly align the section. This is particularly important for + // the alignment of .rodata.cstNN sections. + // + // llvm will emit see paddq statements for x86_64 under + // optimisation and load from RODATA sections, specifically + // .rodata.cst16. Also we may encounter .rodata.cst32 sections + // in objects using AVX instructions (see #23066). + start = m32_alloc(allocator, size, align); if (start == NULL) goto fail; memcpy(start, oc->image + offset, size); alloc = SECTION_M32; ===================================== testsuite/tests/bytecode/T23068.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +module T23068 where +import GHC.Exts + +f :: () -> (# Int, Int #) +f () = (# 0, 0 #) + +g :: () -> (# Int#, Int#, Int #) +g () = (# 0#, 0#, 0 #) ===================================== testsuite/tests/bytecode/T23068.script ===================================== @@ -0,0 +1 @@ +:l T23068 ===================================== testsuite/tests/bytecode/T23068.stdout ===================================== @@ -0,0 +1,71 @@ + +==================== Proto-BCOs ==================== +ProtoBCO T23068.g#1 []: + \r [ds] case of wild + bitmap: 1 [0] + PUSH_ALTS P + ProtoBCO wild#0 []: + { () -> let bcprep = ... in ... + bitmap: 1 [0] + ALLOC_PAP 1 0 + PUSH_BCO + ProtoBCO bcprep#1 []: + \r [void] break<0>() let sat = ... in ... + bitmap: 0 [] + BRK_FUN 0 + PUSH_UBX (1) 0# + PACK GHC.Types.I# 1 + PUSH_L 0 + PUSH_UBX (1) 0# + PUSH_UBX (1) 0# + SLIDE 3 1 + PUSH_UBX (1) 7## + PUSH_BCO + ProtoBCO tuple#0 []: + bitmap: 4 [7] + SLIDE 0 1 + RETURN_TUPLE + RETURN_TUPLE + MKPAP 0 words, 1 stkoff + PUSH_APPLY_V + PUSH_L 1 + SLIDE 2 5 + ENTER + PUSH_L 2 + ENTER + +ProtoBCO T23068.f#1 []: + \r [ds] case of wild + bitmap: 1 [0] + PUSH_ALTS P + ProtoBCO wild#0 []: + { () -> let bcprep = ... in ... + bitmap: 1 [0] + ALLOC_PAP 1 0 + PUSH_BCO + ProtoBCO bcprep#1 []: + \r [void] break<1>() let sat = ... in ... + bitmap: 0 [] + BRK_FUN 1 + PUSH_UBX (1) 0# + PACK GHC.Types.I# 1 + PUSH_UBX (1) 0# + PACK GHC.Types.I# 1 + PUSH_LL 1 0 + SLIDE 2 2 + PUSH_UBX (1) 3## + PUSH_BCO + ProtoBCO tuple#0 []: + bitmap: 3 [1] + SLIDE 0 1 + RETURN_TUPLE + RETURN_TUPLE + MKPAP 0 words, 1 stkoff + PUSH_APPLY_V + PUSH_L 1 + SLIDE 2 5 + ENTER + PUSH_L 2 + ENTER + + ===================================== testsuite/tests/bytecode/all.T ===================================== @@ -0,0 +1,3 @@ +ghci_dump_bcos = [only_ways(['ghci']), extra_run_opts('-dno-typeable-binds -dsuppress-uniques -ddump-bcos')] + +test('T23068', ghci_dump_bcos + [filter_stdout_lines(r'.*bitmap: .*')], ghci_script, ['T23068.script']) ===================================== testsuite/tests/rts/linker/Makefile ===================================== @@ -12,6 +12,11 @@ section_alignment: '$(TEST_HC)' $(TEST_HC_OPTS_NO_RTSOPTS) -v0 --make -no-rtsopts-suggestions -no-hs-main -o runner runner.c ./runner section_alignment.o isAligned +T23066: + '$(TEST_CC)' $(TEST_CC_OPTS) -c -o T23066_c.o T23066_c.c + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RTSOPTS) -v0 --make -no-rtsopts-suggestions -no-hs-main -o runner runner.c -static + ./runner T23066_c.o isAligned + T2615-prep: $(RM) libfoo_T2615.so '$(TEST_HC)' $(TEST_HC_OPTS) -fPIC -c libfoo_T2615.c -o libfoo_T2615.o ===================================== testsuite/tests/rts/linker/T23066.stdout ===================================== @@ -0,0 +1,2 @@ +Linking: path = T23066_c.o, symname = isAligned +1 ===================================== testsuite/tests/rts/linker/T23066_c.c ===================================== @@ -0,0 +1,42 @@ +#include +#include + +extern int foo32_1, foo32_2; + +// The bug in #23066 was that we wouldn't correctly align 32-bytes aligned +// sections, except by chance (we were always aligning on 16 bytes). +// +// Hence we intersperse two 16-bytes aligned sections with two 32-bytes aligned +// sections to ensure that at least one of the 32-bytes aligned section +// triggers the bug (the order of the sections seems to be preserved). + +__asm__( +" .section pad16_1,\"aM\", at progbits,16\n\t" +" .align 16\n\t" +" .byte 0\n\t" +"\n\t" +" .global foo32_1\n\t" +" .section sfoo32_1,\"aM\", at progbits,32\n\t" +" .align 32\n\t" +"foo32_1:\n\t" +" .byte 0\n\t" +"\n\t" +" .section pad16_2,\"aM\", at progbits,16\n\t" +" .align 16\n\t" +" .byte 0\n\t" +"\n\t" +" .global foo32_2\n\t" +" .section sfoo32_2,\"aM\", at progbits,32\n\t" +" .align 32\n\t" +"foo32_2:\n\t" +" .byte 0\n\t" +); + + +#define ALIGN32(x) (((intptr_t)(&x) & 0x1F) == 0) + +int isAligned() { + //printf("%p\n", &foo32_1); + //printf("%p\n", &foo32_2); + return (ALIGN32(foo32_1) && ALIGN32(foo32_2)); +} ===================================== testsuite/tests/rts/linker/all.T ===================================== @@ -16,6 +16,14 @@ test('section_alignment', ], makefile_test, []) +###################################### +test('T23066', + [ unless(arch('x86_64'), skip) + , unless(opsys('linux'), skip) + , extra_files(['runner.c', 'T23066_c.c']) + ], + makefile_test, []) + ###################################### # Test to see if linker scripts link properly to real ELF files test('T2615', ===================================== utils/hpc ===================================== @@ -0,0 +1 @@ +Subproject commit b376045cb3f3d28815ca29d9c07df2e843cec1c3 ===================================== utils/hpc/HpcCombine.hs deleted ===================================== @@ -1,197 +0,0 @@ ---------------------------------------------------------- --- The main program for the hpc-add tool, part of HPC. --- Andy Gill, Oct 2006 ---------------------------------------------------------- - -module HpcCombine (sum_plugin,combine_plugin,map_plugin) where - -import Trace.Hpc.Tix -import Trace.Hpc.Util - -import HpcFlags - -import Control.Monad -import qualified Data.Set as Set -import qualified Data.Map as Map - ------------------------------------------------------------------------------- -sum_options :: FlagOptSeq -sum_options - = excludeOpt - . includeOpt - . outputOpt - . unionModuleOpt - . verbosityOpt - -sum_plugin :: Plugin -sum_plugin = Plugin { name = "sum" - , usage = "[OPTION] .. [ [ ..]]" - , options = sum_options - , summary = "Sum multiple .tix files in a single .tix file" - , implementation = sum_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -combine_options :: FlagOptSeq -combine_options - = excludeOpt - . includeOpt - . outputOpt - . combineFunOpt - . combineFunOptInfo - . unionModuleOpt - . verbosityOpt - -combine_plugin :: Plugin -combine_plugin = Plugin { name = "combine" - , usage = "[OPTION] .. " - , options = combine_options - , summary = "Combine two .tix files in a single .tix file" - , implementation = combine_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -map_options :: FlagOptSeq -map_options - = excludeOpt - . includeOpt - . outputOpt - . mapFunOpt - . mapFunOptInfo - . unionModuleOpt - . verbosityOpt - -map_plugin :: Plugin -map_plugin = Plugin { name = "map" - , usage = "[OPTION] .. " - , options = map_options - , summary = "Map a function over a single .tix file" - , implementation = map_main - , init_flags = default_flags - , final_flags = default_final_flags - } - ------------------------------------------------------------------------------- - -sum_main :: Flags -> [String] -> IO () -sum_main _ [] = hpcError sum_plugin $ "no .tix file specified" -sum_main flags (first_file:more_files) = do - Just tix <- readTix first_file - - tix' <- foldM (mergeTixFile flags (+)) - (filterTix flags tix) - more_files - - case outputFile flags of - "-" -> putStrLn (show tix') - out -> writeTix out tix' - -combine_main :: Flags -> [String] -> IO () -combine_main flags [first_file,second_file] = do - let f = theCombineFun (combineFun flags) - - Just tix1 <- readTix first_file - Just tix2 <- readTix second_file - - let tix = mergeTix (mergeModule flags) - f - (filterTix flags tix1) - (filterTix flags tix2) - - case outputFile flags of - "-" -> putStrLn (show tix) - out -> writeTix out tix -combine_main _ _ = hpcError combine_plugin $ "need exactly two .tix files to combine" - -map_main :: Flags -> [String] -> IO () -map_main flags [first_file] = do - let f = thePostFun (postFun flags) - - Just tix <- readTix first_file - - let (Tix inside_tix) = filterTix flags tix - let tix' = Tix [ TixModule m p i (map f t) - | TixModule m p i t <- inside_tix - ] - - case outputFile flags of - "-" -> putStrLn (show tix') - out -> writeTix out tix' -map_main _ [] = hpcError map_plugin $ "no .tix file specified" -map_main _ _ = hpcError map_plugin $ "to many .tix files specified" - -mergeTixFile :: Flags -> (Integer -> Integer -> Integer) -> Tix -> String -> IO Tix -mergeTixFile flags fn tix file_name = do - Just new_tix <- readTix file_name - return $! strict $ mergeTix (mergeModule flags) fn tix (filterTix flags new_tix) - --- could allow different numbering on the module info, --- as long as the total is the same; will require normalization. - -mergeTix :: MergeFun - -> (Integer -> Integer -> Integer) -> Tix -> Tix -> Tix -mergeTix modComb f - (Tix t1) - (Tix t2) = Tix - [ case (Map.lookup m fm1,Map.lookup m fm2) of - -- todo, revisit the semantics of this combination - (Just (TixModule _ hash1 len1 tix1),Just (TixModule _ hash2 len2 tix2)) - | hash1 /= hash2 - || length tix1 /= length tix2 - || len1 /= length tix1 - || len2 /= length tix2 - -> error $ "mismatched in module " ++ m - | otherwise -> - TixModule m hash1 len1 (zipWith f tix1 tix2) - (Just m1,Nothing) -> - m1 - (Nothing,Just m2) -> - m2 - _ -> error "impossible" - | m <- Set.toList (theMergeFun modComb m1s m2s) - ] - where - m1s = Set.fromList $ map tixModuleName t1 - m2s = Set.fromList $ map tixModuleName t2 - - fm1 = Map.fromList [ (tixModuleName tix,tix) - | tix <- t1 - ] - fm2 = Map.fromList [ (tixModuleName tix,tix) - | tix <- t2 - ] - - --- What I would give for a hyperstrict :-) --- This makes things about 100 times faster. -class Strict a where - strict :: a -> a - -instance Strict Integer where - strict i = i - -instance Strict Int where - strict i = i - -instance Strict Hash where -- should be fine, because Hash is a newtype round an Int - strict i = i - -instance Strict Char where - strict i = i - -instance Strict a => Strict [a] where - strict (a:as) = (((:) $! strict a) $! strict as) - strict [] = [] - -instance (Strict a, Strict b) => Strict (a,b) where - strict (a,b) = (((,) $! strict a) $! strict b) - -instance Strict Tix where - strict (Tix t1) = - Tix $! strict t1 - -instance Strict TixModule where - strict (TixModule m1 p1 i1 t1) = - ((((TixModule $! strict m1) $! strict p1) $! strict i1) $! strict t1) ===================================== utils/hpc/HpcDraft.hs deleted ===================================== @@ -1,144 +0,0 @@ -module HpcDraft (draft_plugin) where - -import Trace.Hpc.Tix -import Trace.Hpc.Mix -import Trace.Hpc.Util - -import HpcFlags - -import qualified Data.Set as Set -import qualified Data.Map as Map -import HpcUtils -import Data.Tree - ------------------------------------------------------------------------------- -draft_options :: FlagOptSeq -draft_options - = excludeOpt - . includeOpt - . srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . outputOpt - . verbosityOpt - -draft_plugin :: Plugin -draft_plugin = Plugin { name = "draft" - , usage = "[OPTION] .. " - , options = draft_options - , summary = "Generate draft overlay that provides 100% coverage" - , implementation = draft_main - , init_flags = default_flags - , final_flags = default_final_flags - } - ------------------------------------------------------------------------------- - -draft_main :: Flags -> [String] -> IO () -draft_main _ [] = error "draft_main: unhandled case: []" -draft_main hpcflags (progName:mods) = do - let hpcflags1 = hpcflags - { includeMods = Set.fromList mods - `Set.union` - includeMods hpcflags } - let prog = getTixFileName $ progName - tix <- readTix prog - case tix of - Just (Tix tickCounts) -> do - outs <- sequence - [ makeDraft hpcflags1 tixModule - | tixModule@(TixModule m _ _ _) <- tickCounts - , allowModule hpcflags1 m - ] - case outputFile hpcflags1 of - "-" -> putStrLn (unlines outs) - out -> writeFile out (unlines outs) - Nothing -> hpcError draft_plugin $ "unable to find tix file for:" ++ progName - - -makeDraft :: Flags -> TixModule -> IO String -makeDraft hpcflags tix = do - let modu = tixModuleName tix - tixs = tixModuleTixs tix - - (Mix filepath _ _ _ entries) <- readMixWithFlags hpcflags (Right tix) - - let forest = createMixEntryDom - [ (srcspan,(box,v > 0)) - | ((srcspan,box),v) <- zip entries tixs - ] - --- let show' (span,stuff) = show (span,stuff,grabHpcPos hsMap span) --- putStrLn $ drawForest $ map (fmap show) $ forest - - let non_ticked = findNotTickedFromList forest - - hs <- readFileFromPath (hpcError draft_plugin) filepath (srcDirs hpcflags) - - let hsMap :: Map.Map Int String - hsMap = Map.fromList (zip [1..] $ lines hs) - - let quoteString = show - - let firstLine pos = case fromHpcPos pos of - (ln,_,_,_) -> ln - - - let showPleaseTick :: Int -> PleaseTick -> String - showPleaseTick d (TickFun str pos) = - spaces d ++ "tick function \"" ++ last str ++ "\" " - ++ "on line " ++ show (firstLine pos) ++ ";" - showPleaseTick d (TickExp pos) = - spaces d ++ "tick " - ++ if '\n' `elem` txt - then "at position " ++ show pos ++ ";" - else quoteString txt ++ " " ++ "on line " ++ show (firstLine pos) ++ ";" - - where - txt = grabHpcPos hsMap pos - - showPleaseTick d (TickInside [str] _ pleases) = - spaces d ++ "inside \"" ++ str ++ "\" {\n" ++ - showPleaseTicks (d + 2) pleases ++ - spaces d ++ "}" - - showPleaseTick _ (TickInside _ _ _) - = error "showPleaseTick: Unhandled case TickInside" - - showPleaseTicks d pleases = unlines (map (showPleaseTick d) pleases) - - spaces d = take d (repeat ' ') - - return $ "module " ++ show (fixPackageSuffix modu) ++ " {\n" ++ - showPleaseTicks 2 non_ticked ++ "}" - -fixPackageSuffix :: String -> String -fixPackageSuffix modu = case span (/= '/') modu of - (before,'/':after) -> before ++ ":" ++ after - _ -> modu - -data PleaseTick - = TickFun [String] HpcPos - | TickExp HpcPos - | TickInside [String] HpcPos [PleaseTick] - deriving Show - -mkTickInside :: [String] -> HpcPos -> [PleaseTick] - -> [PleaseTick] -> [PleaseTick] -mkTickInside _ _ [] = id -mkTickInside nm pos inside = (TickInside nm pos inside :) - -findNotTickedFromTree :: MixEntryDom [(BoxLabel,Bool)] -> [PleaseTick] -findNotTickedFromTree (Node (pos,(ExpBox {},False):_) _) = [TickExp pos] -findNotTickedFromTree (Node (pos,(TopLevelBox nm,False):_) _) - = [ TickFun nm pos ] -findNotTickedFromTree (Node (pos,(LocalBox nm,False):_) _) - = [ TickFun nm pos ] -findNotTickedFromTree (Node (pos,(TopLevelBox nm,True):_) children) - = mkTickInside nm pos (findNotTickedFromList children) [] -findNotTickedFromTree (Node (pos,_:others) children) = - findNotTickedFromTree (Node (pos,others) children) -findNotTickedFromTree (Node (_, []) children) = findNotTickedFromList children - -findNotTickedFromList :: [MixEntryDom [(BoxLabel,Bool)]] -> [PleaseTick] -findNotTickedFromList = concatMap findNotTickedFromTree ===================================== utils/hpc/HpcFlags.hs deleted ===================================== @@ -1,268 +0,0 @@ --- (c) 2007 Andy Gill - -module HpcFlags where - -import System.Console.GetOpt -import qualified Data.Set as Set -import Data.Char -import Trace.Hpc.Tix -import Trace.Hpc.Mix -import System.Exit -import System.FilePath - -data Flags = Flags - { outputFile :: String - , includeMods :: Set.Set String - , excludeMods :: Set.Set String - , hpcDirs :: [String] - , srcDirs :: [String] - , destDir :: String - - , perModule :: Bool - , decList :: Bool - , xmlOutput :: Bool - - , funTotals :: Bool - , altHighlight :: Bool - - , combineFun :: CombineFun -- tick-wise combine - , postFun :: PostFun -- - , mergeModule :: MergeFun -- module-wise merge - - , verbosity :: Verbosity - } - -default_flags :: Flags -default_flags = Flags - { outputFile = "-" - , includeMods = Set.empty - , excludeMods = Set.empty - , hpcDirs = [".hpc"] - , srcDirs = [] - , destDir = "." - - , perModule = False - , decList = False - , xmlOutput = False - - , funTotals = False - , altHighlight = False - - , combineFun = ADD - , postFun = ID - , mergeModule = INTERSECTION - - , verbosity = Normal - } - - -data Verbosity = Silent | Normal | Verbose - deriving (Eq, Ord) - -verbosityFromString :: String -> Verbosity -verbosityFromString "0" = Silent -verbosityFromString "1" = Normal -verbosityFromString "2" = Verbose -verbosityFromString v = error $ "unknown verbosity: " ++ v - - --- We do this after reading flags, because the defaults --- depends on if specific flags we used. - -default_final_flags :: Flags -> Flags -default_final_flags flags = flags - { srcDirs = if null (srcDirs flags) - then ["."] - else srcDirs flags - } - -type FlagOptSeq = [OptDescr (Flags -> Flags)] -> [OptDescr (Flags -> Flags)] - -noArg :: String -> String -> (Flags -> Flags) -> FlagOptSeq -noArg flag detail fn = (:) $ Option [] [flag] (NoArg $ fn) detail - -anArg :: String -> String -> String -> (String -> Flags -> Flags) -> FlagOptSeq -anArg flag detail argtype fn = (:) $ Option [] [flag] (ReqArg fn argtype) detail - -infoArg :: String -> FlagOptSeq -infoArg info = (:) $ Option [] [] (NoArg $ id) info - -excludeOpt, includeOpt, hpcDirOpt, resetHpcDirsOpt, srcDirOpt, - destDirOpt, outputOpt, verbosityOpt, - perModuleOpt, decListOpt, xmlOutputOpt, funTotalsOpt, - altHighlightOpt, combineFunOpt, combineFunOptInfo, mapFunOpt, - mapFunOptInfo, unionModuleOpt :: FlagOptSeq -excludeOpt = anArg "exclude" "exclude MODULE and/or PACKAGE" "[PACKAGE:][MODULE]" - $ \ a f -> f { excludeMods = a `Set.insert` excludeMods f } - -includeOpt = anArg "include" "include MODULE and/or PACKAGE" "[PACKAGE:][MODULE]" - $ \ a f -> f { includeMods = a `Set.insert` includeMods f } - -hpcDirOpt = anArg "hpcdir" "append sub-directory that contains .mix files" "DIR" - (\ a f -> f { hpcDirs = hpcDirs f ++ [a] }) - . infoArg "default .hpc [rarely used]" - -resetHpcDirsOpt = noArg "reset-hpcdirs" "empty the list of hpcdir's" - (\ f -> f { hpcDirs = [] }) - . infoArg "[rarely used]" - -srcDirOpt = anArg "srcdir" "path to source directory of .hs files" "DIR" - (\ a f -> f { srcDirs = srcDirs f ++ [a] }) - . infoArg "multi-use of srcdir possible" - -destDirOpt = anArg "destdir" "path to write output to" "DIR" - $ \ a f -> f { destDir = a } - - -outputOpt = anArg "output" "output FILE" "FILE" $ \ a f -> f { outputFile = a } - -verbosityOpt = anArg "verbosity" "verbosity level, 0-2" "[0-2]" - (\ a f -> f { verbosity = verbosityFromString a }) - . infoArg "default 1" - --- markup - -perModuleOpt = noArg "per-module" "show module level detail" $ \ f -> f { perModule = True } -decListOpt = noArg "decl-list" "show unused decls" $ \ f -> f { decList = True } -xmlOutputOpt = noArg "xml-output" "show output in XML" $ \ f -> f { xmlOutput = True } -funTotalsOpt = noArg "fun-entry-count" "show top-level function entry counts" - $ \ f -> f { funTotals = True } -altHighlightOpt - = noArg "highlight-covered" "highlight covered code, rather that code gaps" - $ \ f -> f { altHighlight = True } - -combineFunOpt = anArg "function" - "combine .tix files with join function, default = ADD" "FUNCTION" - $ \ a f -> case reads (map toUpper a) of - [(c,"")] -> f { combineFun = c } - _ -> error $ "no such combine function : " ++ a -combineFunOptInfo = infoArg - $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst foldFuns) - -mapFunOpt = anArg "function" - "apply function to .tix files, default = ID" "FUNCTION" - $ \ a f -> case reads (map toUpper a) of - [(c,"")] -> f { postFun = c } - _ -> error $ "no such combine function : " ++ a -mapFunOptInfo = infoArg - $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst postFuns) - -unionModuleOpt = noArg "union" - "use the union of the module namespace (default is intersection)" - $ \ f -> f { mergeModule = UNION } - - -------------------------------------------------------------------------------- - -readMixWithFlags :: Flags -> Either String TixModule -> IO Mix -readMixWithFlags flags modu = readMix [ dir hpcDir - | dir <- srcDirs flags - , hpcDir <- hpcDirs flags - ] modu - -------------------------------------------------------------------------------- - -command_usage :: Plugin -> IO () -command_usage plugin = - putStrLn $ - "Usage: hpc " ++ (name plugin) ++ " " ++ - (usage plugin) ++ - "\n" ++ summary plugin ++ "\n" ++ - if null (options plugin []) - then "" - else usageInfo "\n\nOptions:\n" (options plugin []) - -hpcError :: Plugin -> String -> IO a -hpcError plugin msg = do - putStrLn $ "Error: " ++ msg - command_usage plugin - exitFailure - -------------------------------------------------------------------------------- - -data Plugin = Plugin { name :: String - , usage :: String - , options :: FlagOptSeq - , summary :: String - , implementation :: Flags -> [String] -> IO () - , init_flags :: Flags - , final_flags :: Flags -> Flags - } - ------------------------------------------------------------------------------- - --- filterModules takes a list of candidate modules, --- and --- * excludes the excluded modules --- * includes the rest if there are no explicitly included modules --- * otherwise, accepts just the included modules. - -allowModule :: Flags -> String -> Bool -allowModule flags full_mod - | full_mod' `Set.member` excludeMods flags = False - | pkg_name `Set.member` excludeMods flags = False - | mod_name `Set.member` excludeMods flags = False - | Set.null (includeMods flags) = True - | full_mod' `Set.member` includeMods flags = True - | pkg_name `Set.member` includeMods flags = True - | mod_name `Set.member` includeMods flags = True - | otherwise = False - where - full_mod' = pkg_name ++ mod_name - -- pkg name always ends with '/', main - (pkg_name,mod_name) = - case span (/= '/') full_mod of - (p,'/':m) -> (p ++ ":",m) - (m,[]) -> (":",m) - _ -> error "impossible case in allowModule" - -filterTix :: Flags -> Tix -> Tix -filterTix flags (Tix tixs) = - Tix $ filter (allowModule flags . tixModuleName) tixs - - - ------------------------------------------------------------------------------- --- HpcCombine specifics - -data CombineFun = ADD | DIFF | SUB - deriving (Eq,Show, Read, Enum) - -theCombineFun :: CombineFun -> Integer -> Integer -> Integer -theCombineFun fn = case fn of - ADD -> \ l r -> l + r - SUB -> \ l r -> max 0 (l - r) - DIFF -> \ g b -> if g > 0 then 0 else min 1 b - -foldFuns :: [ (String,CombineFun) ] -foldFuns = [ (show comb,comb) - | comb <- [ADD .. SUB] - ] - -data PostFun = ID | INV | ZERO - deriving (Eq,Show, Read, Enum) - -thePostFun :: PostFun -> Integer -> Integer -thePostFun ID x = x -thePostFun INV 0 = 1 -thePostFun INV _ = 0 -thePostFun ZERO _ = 0 - -postFuns :: [(String, PostFun)] -postFuns = [ (show pos,pos) - | pos <- [ID .. ZERO] - ] - - -data MergeFun = INTERSECTION | UNION - deriving (Eq,Show, Read, Enum) - -theMergeFun :: (Ord a) => MergeFun -> Set.Set a -> Set.Set a -> Set.Set a -theMergeFun INTERSECTION = Set.intersection -theMergeFun UNION = Set.union - -mergeFuns :: [(String, MergeFun)] -mergeFuns = [ (show pos,pos) - | pos <- [INTERSECTION,UNION] - ] - ===================================== utils/hpc/HpcLexer.hs deleted ===================================== @@ -1,57 +0,0 @@ -module HpcLexer where - -import Data.Char - -data Token - = ID String - | SYM Char - | INT Int - | STR String - | CAT String - deriving (Eq,Show) - -initLexer :: String -> [Token] -initLexer str = [ t | (_,_,t) <- lexer str 1 1 ] - -lexer :: String -> Int -> Int -> [(Int,Int,Token)] -lexer (c:cs) line column - | c == '\n' = lexer cs (succ line) 1 - | c == '\"' = lexerSTR cs line (succ column) - | c == '[' = lexerCAT cs "" line (succ column) - | c `elem` "{};-:" - = (line,column,SYM c) : lexer cs line (succ column) - | isSpace c = lexer cs line (succ column) - | isAlpha c = lexerKW cs [c] line (succ column) - | isDigit c = lexerINT cs [c] line (succ column) - | otherwise = error "lexer failure" -lexer [] _ _ = [] - -lexerKW :: String -> String -> Int -> Int -> [(Int,Int,Token)] -lexerKW (c:cs) s line column - | isAlpha c = lexerKW cs (s ++ [c]) line (succ column) -lexerKW other s line column = (line,column,ID s) : lexer other line column - -lexerINT :: String -> String -> Int -> Int -> [(Int,Int,Token)] -lexerINT (c:cs) s line column - | isDigit c = lexerINT cs (s ++ [c]) line (succ column) -lexerINT other s line column = (line,column,INT (read s)) : lexer other line column - --- not technically correct for the new column count, but a good approximation. -lexerSTR :: String -> Int -> Int -> [(Int,Int,Token)] -lexerSTR cs line column - = case lex ('"' : cs) of - [(str,rest)] -> (line,succ column,STR (read str)) - : lexer rest line (length (show str) + column + 1) - _ -> error "bad string" - -lexerCAT :: String -> String -> Int -> Int -> [(Int,Int,Token)] -lexerCAT (c:cs) s line column - | c == ']' = (line,column,CAT s) : lexer cs line (succ column) - | otherwise = lexerCAT cs (s ++ [c]) line (succ column) -lexerCAT [] _ _ _ = error "lexer failure in CAT" - -test :: IO () -test = do - t <- readFile "EXAMPLE.tc" - print (initLexer t) - ===================================== utils/hpc/HpcMarkup.hs deleted ===================================== @@ -1,485 +0,0 @@ ---------------------------------------------------------- --- The main program for the hpc-markup tool, part of HPC. --- Andy Gill and Colin Runciman, June 2006 ---------------------------------------------------------- - -module HpcMarkup (markup_plugin) where - -import Trace.Hpc.Mix -import Trace.Hpc.Tix -import Trace.Hpc.Util (HpcPos, fromHpcPos, writeFileUtf8) - -import HpcFlags -import HpcUtils - -import System.FilePath -import Data.List (sortBy, find) -import Data.Maybe(fromJust) -import Data.Semigroup as Semi -import Data.Array -import Control.Monad -import qualified Data.Set as Set - ------------------------------------------------------------------------------- - -markup_options :: FlagOptSeq -markup_options - = excludeOpt - . includeOpt - . srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . funTotalsOpt - . altHighlightOpt - . destDirOpt - . verbosityOpt - -markup_plugin :: Plugin -markup_plugin = Plugin { name = "markup" - , usage = "[OPTION] .. [ [ ..]]" - , options = markup_options - , summary = "Markup Haskell source with program coverage" - , implementation = markup_main - , init_flags = default_flags - , final_flags = default_final_flags - } - ------------------------------------------------------------------------------- - -markup_main :: Flags -> [String] -> IO () -markup_main flags (prog:modNames) = do - let hpcflags1 = flags - { includeMods = Set.fromList modNames - `Set.union` - includeMods flags } - let Flags - { funTotals = theFunTotals - , altHighlight = invertOutput - , destDir = dest_dir - } = hpcflags1 - - mtix <- readTix (getTixFileName prog) - Tix tixs <- case mtix of - Nothing -> hpcError markup_plugin $ "unable to find tix file for: " ++ prog - Just a -> return a - - mods <- - sequence [ genHtmlFromMod dest_dir hpcflags1 tix theFunTotals invertOutput - | tix <- tixs - , allowModule hpcflags1 (tixModuleName tix) - ] - - let index_name = "hpc_index" - index_fun = "hpc_index_fun" - index_alt = "hpc_index_alt" - index_exp = "hpc_index_exp" - - let writeSummary filename cmp = do - let mods' = sortBy cmp mods - - unless (verbosity flags < Normal) $ - putStrLn $ "Writing: " ++ (filename <.> "html") - - writeFileUtf8 (dest_dir filename <.> "html") $ - "" ++ - "" ++ - "" ++ - "\n" ++ - "" ++ - "" ++ - "\n" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - concat [ showModuleSummary (modName,fileName,modSummary) - | (modName,fileName,modSummary) <- mods' - ] ++ - "" ++ - showTotalSummary (mconcat - [ modSummary - | (_,_,modSummary) <- mods' - ]) - ++ "
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
\n" - - writeSummary index_name $ \ (n1,_,_) (n2,_,_) -> compare n1 n2 - - writeSummary index_fun $ \ (_,_,s1) (_,_,s2) -> - compare (percent (topFunTicked s2) (topFunTotal s2)) - (percent (topFunTicked s1) (topFunTotal s1)) - - writeSummary index_alt $ \ (_,_,s1) (_,_,s2) -> - compare (percent (altTicked s2) (altTotal s2)) - (percent (altTicked s1) (altTotal s1)) - - writeSummary index_exp $ \ (_,_,s1) (_,_,s2) -> - compare (percent (expTicked s2) (expTotal s2)) - (percent (expTicked s1) (expTotal s1)) - - -markup_main _ [] - = hpcError markup_plugin $ "no .tix file or executable name specified" - --- Add characters to the left of a string until it is at least as --- large as requested. -padLeft :: Int -> Char -> String -> String -padLeft n c str = go n str - where - -- If the string is already long enough, stop traversing it. - go 0 _ = str - go k [] = replicate k c ++ str - go k (_:xs) = go (k-1) xs - -genHtmlFromMod - :: String - -> Flags - -> TixModule - -> Bool - -> Bool - -> IO (String, [Char], ModuleSummary) -genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do - let theHsPath = srcDirs flags - let modName0 = tixModuleName tix - - (Mix origFile _ _ tabStop mix') <- readMixWithFlags flags (Right tix) - - let arr_tix :: Array Int Integer - arr_tix = listArray (0,length (tixModuleTixs tix) - 1) - $ tixModuleTixs tix - - let tickedWith :: Int -> Integer - tickedWith n = arr_tix ! n - - isTicked n = tickedWith n /= 0 - - let info = [ (pos,theMarkup) - | (gid,(pos,boxLabel)) <- zip [0 ..] mix' - , let binBox = case (isTicked gid,isTicked (gid+1)) of - (False,False) -> [] - (True,False) -> [TickedOnlyTrue] - (False,True) -> [TickedOnlyFalse] - (True,True) -> [] - , let tickBox = if isTicked gid - then [IsTicked] - else [NotTicked] - , theMarkup <- case boxLabel of - ExpBox {} -> tickBox - TopLevelBox {} - -> TopLevelDecl theFunTotals (tickedWith gid) : tickBox - LocalBox {} -> tickBox - BinBox _ True -> binBox - _ -> [] - ] - - - let modSummary = foldr (.) id - [ \ st -> - case boxLabel of - ExpBox False - -> st { expTicked = ticked (expTicked st) - , expTotal = succ (expTotal st) - } - ExpBox True - -> st { expTicked = ticked (expTicked st) - , expTotal = succ (expTotal st) - , altTicked = ticked (altTicked st) - , altTotal = succ (altTotal st) - } - TopLevelBox _ -> - st { topFunTicked = ticked (topFunTicked st) - , topFunTotal = succ (topFunTotal st) - } - _ -> st - | (gid,(_pos,boxLabel)) <- zip [0 ..] mix' - , let ticked = if isTicked gid - then succ - else id - ] $ mempty - - -- add prefix to modName argument - content <- readFileFromPath (hpcError markup_plugin) origFile theHsPath - - let content' = markup tabStop info content - let addLine n xs = "" ++ padLeft 5 ' ' (show n) ++ " " ++ xs - let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines - let fileName = modName0 <.> "hs" <.> "html" - unless (verbosity flags < Normal) $ - putStrLn $ "Writing: " ++ fileName - writeFileUtf8 (dest_dir fileName) $ - unlines ["", - "", - "", - "", - "", - "", - "
",
-                     concat [
-                         "",
-                         "never executed ",
-                         "always true ",
-                         "always false"],
-                     "
", - "
"] ++ addLines content' ++ "\n
\n\n\n"; - - - modSummary `seq` return (modName0,fileName,modSummary) - -data Loc = Loc !Int !Int - deriving (Eq,Ord,Show) - -data Markup - = NotTicked - | TickedOnlyTrue - | TickedOnlyFalse - | IsTicked - | TopLevelDecl - Bool -- display entry totals - Integer - deriving (Eq,Show) - -markup :: Int -- ^tabStop - -> [(HpcPos,Markup)] -- random list of tick location pairs - -> String -- text to mark up - -> String -markup tabStop mix str = addMarkup tabStop str (Loc 1 1) [] sortedTickLocs - where - tickLocs = [ (Loc ln1 c1,Loc ln2 c2,mark) - | (pos,mark) <- mix - , let (ln1,c1,ln2,c2) = fromHpcPos pos - ] - sortedTickLocs = sortBy (\(locA1,locZ1,_) (locA2,locZ2,_) -> - (locA1,locZ2) `compare` (locA2,locZ1)) tickLocs - -addMarkup :: Int -- tabStop - -> String -- text to mark up - -> Loc -- current location - -> [(Loc,Markup)] -- stack of open ticks, with closing location - -> [(Loc,Loc,Markup)] -- sorted list of tick location pairs - -> String - --- check the pre-condition. ---addMarkup tabStop cs loc os ticks --- | not (isSorted (map fst os)) = error $ "addMarkup: bad closing ordering: " ++ show os - ---addMarkup tabStop cs loc os@(_:_) ticks --- | trace (show (loc,os,take 10 ticks)) False = undefined - --- close all open ticks, if we have reached the end -addMarkup _ [] _loc os [] = - concatMap (const closeTick) os -addMarkup tabStop cs loc ((o,_):os) ticks | loc > o = - closeTick ++ addMarkup tabStop cs loc os ticks - ---addMarkup tabStop cs loc os ((t1,t2,tik@(TopLevelDecl {})):ticks) | loc == t1 = --- openTick tik ++ closeTick ++ addMarkup tabStop cs loc os ticks - -addMarkup tabStop cs loc os ((t1,t2,tik0):ticks) | loc == t1 = - case os of - ((_,tik'):_) - | not (allowNesting tik0 tik') - -> addMarkup tabStop cs loc os ticks -- already marked or bool within marked bool - _ -> openTick tik0 ++ addMarkup tabStop cs loc (addTo (t2,tik0) os) ticks - where - - addTo (t,tik) [] = [(t,tik)] - addTo (t,tik) ((t',tik'):xs) | t <= t' = (t,tik):(t',tik'):xs - | otherwise = (t',tik):(t',tik'):xs - -addMarkup tabStop0 cs loc os ((t1,_t2,_tik):ticks) | loc > t1 = - -- throw away this tick, because it is from a previous place ?? - addMarkup tabStop0 cs loc os ticks - -addMarkup tabStop0 ('\n':cs) loc@(Loc ln col) os@((Loc ln2 col2,_):_) ticks - | ln == ln2 && col < col2 - = addMarkup tabStop0 (' ':'\n':cs) loc os ticks -addMarkup tabStop0 (c0:cs) loc@(Loc _ p) os ticks = - if c0=='\n' && os/=[] then - concatMap (const closeTick) (downToTopLevel os) ++ - c0 : "" ++ expand 1 w ++ "" ++ - concatMap (openTick.snd) (reverse (downToTopLevel os)) ++ - addMarkup tabStop0 cs' loc' os ticks - else if c0=='\t' then - expand p "\t" ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks - else - escape c0 ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks - where - (w,cs') = span (`elem` " \t") cs - loc' = foldl (flip incBy) loc (c0:w) - escape '>' = ">" - escape '<' = "<" - escape '"' = """ - escape '&' = "&" - escape c = [c] - - expand :: Int -> String -> String - expand _ "" = "" - expand c ('\t':s) = replicate (c' - c) ' ' ++ expand c' s - where - c' = tabStopAfter 8 c - expand c (' ':s) = ' ' : expand (c+1) s - expand _ _ = error "bad character in string for expansion" - - incBy :: Char -> Loc -> Loc - incBy '\n' (Loc ln _c) = Loc (succ ln) 1 - incBy '\t' (Loc ln c) = Loc ln (tabStopAfter tabStop0 c) - incBy _ (Loc ln c) = Loc ln (succ c) - - tabStopAfter :: Int -> Int -> Int - tabStopAfter tabStop c = fromJust (find (>c) [1,(tabStop + 1)..]) - - -addMarkup tabStop cs loc os ticks = "ERROR: " ++ show (take 10 cs,tabStop,loc,take 10 os,take 10 ticks) - -openTick :: Markup -> String -openTick NotTicked = "" -openTick IsTicked = "" -openTick TickedOnlyTrue = "" -openTick TickedOnlyFalse = "" -openTick (TopLevelDecl False _) = openTopDecl -openTick (TopLevelDecl True 0) - = "-- never entered" ++ - openTopDecl -openTick (TopLevelDecl True 1) - = "-- entered once" ++ - openTopDecl -openTick (TopLevelDecl True n0) - = "-- entered " ++ showBigNum n0 ++ " times" ++ openTopDecl - where showBigNum n | n <= 9999 = show n - | otherwise = case n `quotRem` 1000 of - (q, r) -> showBigNum' q ++ "," ++ showWith r - showBigNum' n | n <= 999 = show n - | otherwise = case n `quotRem` 1000 of - (q, r) -> showBigNum' q ++ "," ++ showWith r - showWith n = padLeft 3 '0' $ show n - - - -closeTick :: String -closeTick = "" - -openTopDecl :: String -openTopDecl = "" - -downToTopLevel :: [(Loc,Markup)] -> [(Loc,Markup)] -downToTopLevel ((_,TopLevelDecl {}):_) = [] -downToTopLevel (o : os) = o : downToTopLevel os -downToTopLevel [] = [] - - --- build in logic for nesting bin boxes - -allowNesting :: Markup -- innermost - -> Markup -- outermost - -> Bool -allowNesting n m | n == m = False -- no need to double nest -allowNesting IsTicked TickedOnlyFalse = False -allowNesting IsTicked TickedOnlyTrue = False -allowNesting _ _ = True - ------------------------------------------------------------------------------- - -data ModuleSummary = ModuleSummary - { expTicked :: !Int - , expTotal :: !Int - , topFunTicked :: !Int - , topFunTotal :: !Int - , altTicked :: !Int - , altTotal :: !Int - } - deriving (Show) - - -showModuleSummary :: (String, String, ModuleSummary) -> String -showModuleSummary (modName,fileName,modSummary) = - "\n" ++ - "  module " - ++ modName ++ "\n" ++ - showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++ - showSummary (altTicked modSummary) (altTotal modSummary) ++ - showSummary (expTicked modSummary) (expTotal modSummary) ++ - "\n" - -showTotalSummary :: ModuleSummary -> String -showTotalSummary modSummary = - "\n" ++ - "  Program Coverage Total\n" ++ - showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++ - showSummary (altTicked modSummary) (altTotal modSummary) ++ - showSummary (expTicked modSummary) (expTotal modSummary) ++ - "\n" - -showSummary :: (Integral t, Show t) => t -> t -> String -showSummary ticked total = - "" ++ showP (percent ticked total) ++ "" ++ - "" ++ show ticked ++ "/" ++ show total ++ "" ++ - "" ++ - (case percent ticked total of - Nothing -> " " - Just w -> bar w "bar" - ) ++ "" - where - showP Nothing = "- " - showP (Just x) = show x ++ "%" - bar 0 _ = bar 100 "invbar" - bar w inner = "" ++ - "
" ++ - "" ++ - "
" - -percent :: (Integral a) => a -> a -> Maybe a -percent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` total) - -instance Semi.Semigroup ModuleSummary where - (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1) <> (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2) - = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2) - -instance Monoid ModuleSummary where - mempty = ModuleSummary - { expTicked = 0 - , expTotal = 0 - , topFunTicked = 0 - , topFunTotal = 0 - , altTicked = 0 - , altTotal = 0 - } - mappend = (<>) - ------------------------------------------------------------------------------- --- global color palette - -red,green,yellow :: String -red = "#f20913" -green = "#60de51" -yellow = "yellow" ===================================== utils/hpc/HpcOverlay.hs deleted ===================================== @@ -1,157 +0,0 @@ -module HpcOverlay where - -import HpcFlags -import HpcParser -import HpcUtils -import Trace.Hpc.Tix -import Trace.Hpc.Mix -import Trace.Hpc.Util -import qualified Data.Map as Map -import Data.Tree - -overlay_options :: FlagOptSeq -overlay_options - = srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . outputOpt - . verbosityOpt - -overlay_plugin :: Plugin -overlay_plugin = Plugin { name = "overlay" - , usage = "[OPTION] .. [ [...]]" - , options = overlay_options - , summary = "Generate a .tix file from an overlay file" - , implementation = overlay_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -overlay_main :: Flags -> [String] -> IO () -overlay_main _ [] = hpcError overlay_plugin $ "no overlay file specified" -overlay_main flags files = do - specs <- mapM hpcParser files - let (Spec globals modules) = concatSpec specs - - let modules1 = Map.fromListWith (++) [ (m,info) | (m,info) <- modules ] - - mod_info <- - sequence [ do mix@(Mix origFile _ _ _ _) <- readMixWithFlags flags (Left modu) - content <- readFileFromPath (hpcError overlay_plugin) origFile (srcDirs flags) - processModule modu content mix mod_spec globals - | (modu, mod_spec) <- Map.toList modules1 - ] - - - let tix = Tix $ mod_info - - case outputFile flags of - "-" -> putStrLn (show tix) - out -> writeFile out (show tix) - - -processModule :: String -- ^ module name - -> String -- ^ module contents - -> Mix -- ^ mix entry for this module - -> [Tick] -- ^ local ticks - -> [ExprTick] -- ^ global ticks - -> IO TixModule -processModule modName modContents (Mix _ _ hash _ entries) locals globals = do - - let hsMap :: Map.Map Int String - hsMap = Map.fromList (zip [1..] $ lines modContents) - - let topLevelFunctions = - Map.fromListWith (++) - [ (nm,[pos]) - | (pos,TopLevelBox [nm]) <- entries - ] - - let inside :: HpcPos -> String -> Bool - inside pos nm = - case Map.lookup nm topLevelFunctions of - Nothing -> False - Just poss -> any (pos `insideHpcPos`) poss - - -- TODO: rename plzTick => plzExprTick, plzTopPick => plzTick - let plzTick :: HpcPos -> BoxLabel -> ExprTick -> Bool - plzTick pos (ExpBox _) (TickExpression _ match q _) = - qualifier pos q - && case match of - Nothing -> True - Just str -> str == grabHpcPos hsMap pos - plzTick _ _ _ = False - - - plzTopTick :: HpcPos -> BoxLabel -> Tick -> Bool - plzTopTick pos label (ExprTick ignore) = plzTick pos label ignore - plzTopTick pos _ (TickFunction fn q _) = - qualifier pos q && pos `inside` fn - plzTopTick pos label (InsideFunction fn igs) = - pos `inside` fn && any (plzTopTick pos label) igs - - - let tixs = Map.fromList - [ (ix, - any (plzTick pos label) globals - || any (plzTopTick pos label) locals) - | (ix,(pos,label)) <- zip [0..] entries - ] - - - -- let show' (srcspan,stuff) = show (srcspan,stuff,grabHpcPos hsMap span) - - let forest = createMixEntryDom - [ (srcspan,ix) - | ((srcspan,_),ix) <- zip entries [0..] - ] - - - -- - let forest2 = addParentToList [] $ forest --- putStrLn $ drawForest $ map (fmap show') $ forest2 - - let isDomList = Map.fromList - [ (ix,filter (/= ix) rng ++ dom) - | (_,(rng,dom)) <- concatMap flatten forest2 - , ix <- rng - ] - - -- We do not use laziness here, because the dominator lists - -- point to their equivent peers, creating loops. - - - let isTicked n = - case Map.lookup n tixs of - Just v -> v - Nothing -> error $ "can not find ix # " ++ show n - - let tixs' = [ case Map.lookup n isDomList of - Just vs -> if any isTicked (n : vs) then 1 else 0 - Nothing -> error $ "can not find ix in dom list # " ++ show n - | n <- [0..(length entries - 1)] - ] - - return $ TixModule modName hash (length tixs') tixs' - -qualifier :: HpcPos -> Maybe Qualifier -> Bool -qualifier _ Nothing = True -qualifier pos (Just (OnLine n)) = n == l1 && n == l2 - where (l1,_,l2,_) = fromHpcPos pos -qualifier pos (Just (AtPosition l1' c1' l2' c2')) - = (l1', c1', l2', c2') == fromHpcPos pos - -concatSpec :: [Spec] -> Spec -concatSpec = foldr - (\ (Spec pre1 body1) (Spec pre2 body2) - -> Spec (pre1 ++ pre2) (body1 ++ body2)) - (Spec [] []) - - - -addParentToTree :: [a] -> MixEntryDom [a] -> MixEntryDom ([a],[a]) -addParentToTree path (Node (pos,a) children) = - Node (pos,(a,path)) (addParentToList (a ++ path) children) - -addParentToList :: [a] -> [MixEntryDom [a]] -> [MixEntryDom ([a],[a])] -addParentToList path nodes = map (addParentToTree path) nodes ===================================== utils/hpc/HpcParser.y deleted ===================================== @@ -1,106 +0,0 @@ -{ -module HpcParser where - -import HpcLexer -} - -%name parser -%expect 0 -%tokentype { Token } - -%token - MODULE { ID "module" } - TICK { ID "tick" } - EXPRESSION { ID "expression" } - ON { ID "on" } - LINE { ID "line" } - POSITION { ID "position" } - FUNCTION { ID "function" } - INSIDE { ID "inside" } - AT { ID "at" } - ':' { SYM ':' } - '-' { SYM '-' } - ';' { SYM ';' } - '{' { SYM '{' } - '}' { SYM '}' } - int { INT $$ } - string { STR $$ } - cat { CAT $$ } -%% - -Spec :: { Spec } -Spec : Ticks Modules { Spec ($1 []) ($2 []) } - -Modules :: { L (ModuleName,[Tick]) } -Modules : Modules Module { $1 . ((:) $2) } - | { id } - -Module :: { (ModuleName,[Tick]) } -Module : MODULE string '{' TopTicks '}' - { ($2,$4 []) } - -TopTicks :: { L Tick } -TopTicks : TopTicks TopTick { $1 . ((:) $2) } - | { id } - -TopTick :: { Tick } -TopTick : Tick { ExprTick $1 } - | TICK FUNCTION string optQual optCat ';' - { TickFunction $3 $4 $5 } - | INSIDE string '{' TopTicks '}' - { InsideFunction $2 ($4 []) } - -Ticks :: { L ExprTick } -Ticks : Ticks Tick { $1 . ((:) $2) } - | { id } - -Tick :: { ExprTick } -Tick : TICK optString optQual optCat ';' - { TickExpression False $2 $3 $4 } - -optString :: { Maybe String } -optString : string { Just $1 } - | { Nothing } - -optQual :: { Maybe Qualifier } -optQual : ON LINE int { Just (OnLine $3) } - | AT POSITION int ':' int '-' int ':' int - { Just (AtPosition $3 $5 $7 $9) } - | { Nothing } -optCat :: { Maybe String } -optCat : cat { Just $1 } - | { Nothing } - -{ -type L a = [a] -> [a] - -type ModuleName = String - -data Spec - = Spec [ExprTick] [(ModuleName,[Tick])] - deriving (Show) - -data ExprTick - = TickExpression Bool (Maybe String) (Maybe Qualifier) (Maybe String) - deriving (Show) - -data Tick - = ExprTick ExprTick - | TickFunction String (Maybe Qualifier) (Maybe String) - | InsideFunction String [Tick] - deriving (Show) - -data Qualifier = OnLine Int - | AtPosition Int Int Int Int - deriving (Show) - - - -hpcParser :: String -> IO Spec -hpcParser filename = do - txt <- readFile filename - let tokens = initLexer txt - return $ parser tokens - -happyError e = error $ show (take 10 e) -} ===================================== utils/hpc/HpcReport.hs deleted ===================================== @@ -1,277 +0,0 @@ ---------------------------------------------------------- --- The main program for the hpc-report tool, part of HPC. --- Colin Runciman and Andy Gill, June 2006 ---------------------------------------------------------- - -module HpcReport (report_plugin) where - -import Prelude hiding (exp) -import Data.List(sort,intersperse,sortBy) -import HpcFlags -import Trace.Hpc.Mix -import Trace.Hpc.Tix -import Control.Monad hiding (guard) -import qualified Data.Set as Set - -notExpecting :: String -> a -notExpecting s = error ("not expecting "++s) - -data BoxTixCounts = BT {boxCount, tixCount :: !Int} - -btZero :: BoxTixCounts -btZero = BT {boxCount=0, tixCount=0} - -btPlus :: BoxTixCounts -> BoxTixCounts -> BoxTixCounts -btPlus (BT b1 t1) (BT b2 t2) = BT (b1+b2) (t1+t2) - -btPercentage :: String -> BoxTixCounts -> String -btPercentage s (BT b t) = showPercentage s t b - -showPercentage :: String -> Int -> Int -> String -showPercentage s 0 0 = "100% "++s++" (0/0)" -showPercentage s n d = showWidth 3 p++"% "++ - s++ - " ("++show n++"/"++show d++")" - where - p = (n*100) `div` d - showWidth w x0 = replicate (shortOf w (length sx)) ' ' ++ sx - where - sx = show x0 - shortOf x y = if y < x then x-y else 0 - -data BinBoxTixCounts = BBT { binBoxCount - , onlyTrueTixCount - , onlyFalseTixCount - , bothTixCount :: !Int} - -bbtzero :: BinBoxTixCounts -bbtzero = BBT { binBoxCount=0 - , onlyTrueTixCount=0 - , onlyFalseTixCount=0 - , bothTixCount=0} - -bbtPlus :: BinBoxTixCounts -> BinBoxTixCounts -> BinBoxTixCounts -bbtPlus (BBT b1 tt1 ft1 bt1) (BBT b2 tt2 ft2 bt2) = - BBT (b1+b2) (tt1+tt2) (ft1+ft2) (bt1+bt2) - -bbtPercentage :: String -> Bool -> BinBoxTixCounts -> String -bbtPercentage s withdetail (BBT b tt ft bt) = - showPercentage s bt b ++ - if withdetail && bt/=b then - detailFor tt "always True"++ - detailFor ft "always False"++ - detailFor (b-(tt+ft+bt)) "unevaluated" - else "" - where - detailFor n txt = if n>0 then ", "++show n++" "++txt - else "" - -data ModInfo = MI { exp,alt,top,loc :: !BoxTixCounts - , guard,cond,qual :: !BinBoxTixCounts - , decPaths :: [[String]]} - -miZero :: ModInfo -miZero = MI { exp=btZero - , alt=btZero - , top=btZero - , loc=btZero - , guard=bbtzero - , cond=bbtzero - , qual=bbtzero - , decPaths = []} - -miPlus :: ModInfo -> ModInfo -> ModInfo -miPlus mi1 mi2 = - MI { exp = exp mi1 `btPlus` exp mi2 - , alt = alt mi1 `btPlus` alt mi2 - , top = top mi1 `btPlus` top mi2 - , loc = loc mi1 `btPlus` loc mi2 - , guard = guard mi1 `bbtPlus` guard mi2 - , cond = cond mi1 `bbtPlus` cond mi2 - , qual = qual mi1 `bbtPlus` qual mi2 - , decPaths = decPaths mi1 ++ decPaths mi2 } - -allBinCounts :: ModInfo -> BinBoxTixCounts -allBinCounts mi = - BBT { binBoxCount = sumAll binBoxCount - , onlyTrueTixCount = sumAll onlyTrueTixCount - , onlyFalseTixCount = sumAll onlyFalseTixCount - , bothTixCount = sumAll bothTixCount } - where - sumAll f = f (guard mi) + f (cond mi) + f (qual mi) - -accumCounts :: [(BoxLabel,Integer)] -> ModInfo -> ModInfo -accumCounts [] mi = mi -accumCounts ((bl,btc):etc) mi - | single bl = accumCounts etc mi' - where - mi' = case bl of - ExpBox False -> mi{exp = inc (exp mi)} - ExpBox True -> mi{exp = inc (exp mi), alt = inc (alt mi)} - TopLevelBox dp -> mi{top = inc (top mi) - ,decPaths = upd dp (decPaths mi)} - LocalBox dp -> mi{loc = inc (loc mi) - ,decPaths = upd dp (decPaths mi)} - _other -> notExpecting "BoxLabel in accumcounts" - inc (BT {boxCount=bc,tixCount=tc}) = - BT { boxCount = bc+1 - , tixCount = tc + bit (btc>0) } - upd dp dps = - if btc>0 then dps else dp:dps -accumCounts [_] _ = error "accumCounts: Unhandled case: [_] _" -accumCounts ((bl0,btc0):(bl1,btc1):etc) mi = - accumCounts etc mi' - where - mi' = case (bl0,bl1) of - (BinBox GuardBinBox True, BinBox GuardBinBox False) -> - mi{guard = inc (guard mi)} - (BinBox CondBinBox True, BinBox CondBinBox False) -> - mi{cond = inc (cond mi)} - (BinBox QualBinBox True, BinBox QualBinBox False) -> - mi{qual = inc (qual mi)} - _other -> notExpecting "BoxLabel pair in accumcounts" - inc (BBT { binBoxCount=bbc - , onlyTrueTixCount=ttc - , onlyFalseTixCount=ftc - , bothTixCount=btc}) = - BBT { binBoxCount = bbc+1 - , onlyTrueTixCount = ttc + bit (btc0 >0 && btc1==0) - , onlyFalseTixCount = ftc + bit (btc0==0 && btc1 >0) - , bothTixCount = btc + bit (btc0 >0 && btc1 >0) } - -bit :: Bool -> Int -bit True = 1 -bit False = 0 - -single :: BoxLabel -> Bool -single (ExpBox {}) = True -single (TopLevelBox _) = True -single (LocalBox _) = True -single (BinBox {}) = False - -modInfo :: Flags -> Bool -> TixModule -> IO ModInfo -modInfo hpcflags qualDecList tix@(TixModule moduleName _ _ tickCounts) = do - Mix _ _ _ _ mes <- readMixWithFlags hpcflags (Right tix) - return (q (accumCounts (zip (map snd mes) tickCounts) miZero)) - where - q mi = if qualDecList then mi{decPaths = map (moduleName:) (decPaths mi)} - else mi - -modReport :: Flags -> TixModule -> IO () -modReport hpcflags tix@(TixModule moduleName _ _ _) = do - mi <- modInfo hpcflags False tix - if xmlOutput hpcflags - then putStrLn $ " " - else putStrLn ("----------") - printModInfo hpcflags mi - if xmlOutput hpcflags - then putStrLn $ " " - else return () - -printModInfo :: Flags -> ModInfo -> IO () -printModInfo hpcflags mi | xmlOutput hpcflags = do - element "exprs" (xmlBT $ exp mi) - element "booleans" (xmlBBT $ allBinCounts mi) - element "guards" (xmlBBT $ guard mi) - element "conditionals" (xmlBBT $ cond mi) - element "qualifiers" (xmlBBT $ qual mi) - element "alts" (xmlBT $ alt mi) - element "local" (xmlBT $ loc mi) - element "toplevel" (xmlBT $ top mi) -printModInfo hpcflags mi = do - putStrLn (btPercentage "expressions used" (exp mi)) - putStrLn (bbtPercentage "boolean coverage" False (allBinCounts mi)) - putStrLn (" "++bbtPercentage "guards" True (guard mi)) - putStrLn (" "++bbtPercentage "'if' conditions" True (cond mi)) - putStrLn (" "++bbtPercentage "qualifiers" True (qual mi)) - putStrLn (btPercentage "alternatives used" (alt mi)) - putStrLn (btPercentage "local declarations used" (loc mi)) - putStrLn (btPercentage "top-level declarations used" (top mi)) - modDecList hpcflags mi - -modDecList :: Flags -> ModInfo -> IO () -modDecList hpcflags mi0 = - when (decList hpcflags && someDecsUnused mi0) $ do - putStrLn "unused declarations:" - mapM_ showDecPath (sort (decPaths mi0)) - where - someDecsUnused mi = tixCount (top mi) < boxCount (top mi) || - tixCount (loc mi) < boxCount (loc mi) - showDecPath dp = putStrLn (" "++ - concat (intersperse "." dp)) - -report_plugin :: Plugin -report_plugin = Plugin { name = "report" - , usage = "[OPTION] .. [ [ ..]]" - , options = report_options - , summary = "Output textual report about program coverage" - , implementation = report_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -report_main :: Flags -> [String] -> IO () -report_main hpcflags (progName:mods) = do - let hpcflags1 = hpcflags - { includeMods = Set.fromList mods - `Set.union` - includeMods hpcflags } - let prog = getTixFileName $ progName - tix <- readTix prog - case tix of - Just (Tix tickCounts) -> - makeReport hpcflags1 progName - $ sortBy (\ mod1 mod2 -> tixModuleName mod1 `compare` tixModuleName mod2) - $ [ tix' - | tix'@(TixModule m _ _ _) <- tickCounts - , allowModule hpcflags1 m - ] - Nothing -> hpcError report_plugin $ "unable to find tix file for:" ++ progName -report_main _ [] = - hpcError report_plugin $ "no .tix file or executable name specified" - -makeReport :: Flags -> String -> [TixModule] -> IO () -makeReport hpcflags progName modTcs | xmlOutput hpcflags = do - putStrLn $ "" - putStrLn $ "" - if perModule hpcflags - then mapM_ (modReport hpcflags) modTcs - else return () - mis <- mapM (modInfo hpcflags True) modTcs - putStrLn $ " " - printModInfo hpcflags (foldr miPlus miZero mis) - putStrLn $ " " - putStrLn $ "" -makeReport hpcflags _ modTcs = - if perModule hpcflags then - mapM_ (modReport hpcflags) modTcs - else do - mis <- mapM (modInfo hpcflags True) modTcs - printModInfo hpcflags (foldr miPlus miZero mis) - -element :: String -> [(String,String)] -> IO () -element tag attrs = putStrLn $ - " <" ++ tag ++ " " - ++ unwords [ x ++ "=" ++ show y - | (x,y) <- attrs - ] ++ "/>" - -xmlBT :: BoxTixCounts -> [(String, String)] -xmlBT (BT b t) = [("boxes",show b),("count",show t)] - -xmlBBT :: BinBoxTixCounts -> [(String, String)] -xmlBBT (BBT b tt tf bt) = [("boxes",show b),("true",show tt),("false",show tf),("count",show (tt + tf + bt))] - ------------------------------------------------------------------------------- - -report_options :: FlagOptSeq -report_options - = perModuleOpt - . decListOpt - . excludeOpt - . includeOpt - . srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . xmlOutputOpt - . verbosityOpt ===================================== utils/hpc/HpcShowTix.hs deleted ===================================== @@ -1,63 +0,0 @@ -module HpcShowTix (showtix_plugin) where - -import Trace.Hpc.Mix -import Trace.Hpc.Tix - -import HpcFlags - -import qualified Data.Set as Set - -showtix_options :: FlagOptSeq -showtix_options - = excludeOpt - . includeOpt - . srcDirOpt - . hpcDirOpt - . resetHpcDirsOpt - . outputOpt - . verbosityOpt - -showtix_plugin :: Plugin -showtix_plugin = Plugin { name = "show" - , usage = "[OPTION] .. [ [ ..]]" - , options = showtix_options - , summary = "Show .tix file in readable, verbose format" - , implementation = showtix_main - , init_flags = default_flags - , final_flags = default_final_flags - } - - -showtix_main :: Flags -> [String] -> IO () -showtix_main _ [] = hpcError showtix_plugin $ "no .tix file or executable name specified" -showtix_main flags (prog:modNames) = do - let hpcflags1 = flags - { includeMods = Set.fromList modNames - `Set.union` - includeMods flags } - - optTixs <- readTix (getTixFileName prog) - case optTixs of - Nothing -> hpcError showtix_plugin $ "could not read .tix file : " ++ prog - Just (Tix tixs) -> do - tixs_mixs <- sequence - [ do mix <- readMixWithFlags hpcflags1 (Right tix) - return $ (tix,mix) - | tix <- tixs - , allowModule hpcflags1 (tixModuleName tix) - ] - - let rjust n str = take (n - length str) (repeat ' ') ++ str - let ljust n str = str ++ take (n - length str) (repeat ' ') - - sequence_ [ sequence_ [ putStrLn (rjust 5 (show ix) ++ " " ++ - rjust 10 (show count) ++ " " ++ - ljust 20 modName ++ " " ++ rjust 20 (show pos) ++ " " ++ show lab) - | (count,ix,(pos,lab)) <- zip3 tixs' [(0::Int)..] entries - ] - | ( TixModule modName _hash1 _ tixs' - , Mix _file _timestamp _hash2 _tab entries - ) <- tixs_mixs - ] - - return () ===================================== utils/hpc/HpcUtils.hs deleted ===================================== @@ -1,37 +0,0 @@ -module HpcUtils where - -import Trace.Hpc.Util (catchIO, HpcPos, fromHpcPos, readFileUtf8) -import qualified Data.Map as Map -import System.FilePath - -dropWhileEndLE :: (a -> Bool) -> [a] -> [a] --- Spec: dropWhileEndLE p = reverse . dropWhile p . reverse -dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x:r) [] - --- turns \n into ' ' --- | grab's the text behind a HpcPos; -grabHpcPos :: Map.Map Int String -> HpcPos -> String -grabHpcPos hsMap srcspan = - case lns of - [] -> error "grabHpcPos: invalid source span" - [ln] -> (take ((c2 - c1) + 1) $ drop (c1 - 1) ln) - hd : tl -> - let lns1 = drop (c1 -1) hd : tl - lns2 = init lns1 ++ [take (c2 + 1) (last lns1) ] - in foldl1 (\ xs ys -> xs ++ "\n" ++ ys) lns2 - where (l1,c1,l2,c2) = fromHpcPos srcspan - lns = map (\ n -> case Map.lookup n hsMap of - Just ln -> ln - Nothing -> error $ "bad line number : " ++ show n - ) [l1..l2] - - -readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String -readFileFromPath _ filename@('/':_) _ = readFileUtf8 filename -readFileFromPath err filename path0 = readTheFile path0 - where - readTheFile [] = err $ "could not find " ++ show filename - ++ " in path " ++ show path0 - readTheFile (dir:dirs) = - catchIO (readFileUtf8 (dir filename)) - (\ _ -> readTheFile dirs) ===================================== utils/hpc/Main.hs deleted ===================================== @@ -1,217 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables, TupleSections #-} --- (c) 2007 Andy Gill - --- Main driver for Hpc -import Control.Monad (forM, forM_, when) -import Data.Bifunctor (bimap) -import Data.List (intercalate, partition, uncons) -import Data.List.NonEmpty (NonEmpty((:|))) -import Data.Maybe (catMaybes, isJust) -import Data.Version -import System.Environment -import System.Exit -import System.Console.GetOpt -import System.Directory (doesPathExist) - -import HpcFlags -import HpcReport -import HpcMarkup -import HpcCombine -import HpcShowTix -import HpcDraft -import HpcOverlay -import Paths_hpc_bin - -helpList :: IO () -helpList = do - putStrLn $ - "Usage: hpc COMMAND ...\n\n" ++ - section "Commands" help ++ - section "Reporting Coverage" reporting ++ - section "Processing Coverage files" processing ++ - section "Coverage Overlays" overlays ++ - section "Others" other ++ - "" - putStrLn "" - putStrLn "or: hpc @response_file_1 @response_file_2 ..." - putStrLn "" - putStrLn "The contents of a Response File must have this format:" - putStrLn "COMMAND ..." - putStrLn "" - putStrLn "example:" - putStrLn "report my_library.tix --include=ModuleA \\" - putStrLn "--include=ModuleB" - where - help = ["help"] - reporting = ["report","markup"] - overlays = ["overlay","draft"] - processing = ["sum","combine","map"] - other = [ name hook - | hook <- hooks - , name hook `notElem` - (concat [help,reporting,processing,overlays]) - ] - -section :: String -> [String] -> String -section _ [] = "" -section msg cmds = msg ++ ":\n" - ++ unlines [ take 14 (" " ++ cmd ++ repeat ' ') ++ summary hook - | cmd <- cmds - , hook <- hooks - , name hook == cmd - ] - -dispatch :: [String] -> IO () -dispatch [] = do - helpList - exitWith ExitSuccess -dispatch (txt:args0) = do - case lookup txt hooks' of - Just plugin -> parse plugin args0 - _ -> case getResponseFileName txt of - Nothing -> parse help_plugin (txt:args0) - Just firstResponseFileName -> do - let - (responseFileNames', nonResponseFileNames) = partitionFileNames args0 - -- if arguments are combination of Response Files and non-Response Files, exit with error - when (length nonResponseFileNames > 0) $ do - let - putStrLn $ "First argument '" <> txt <> "' is a Response File, " <> - "followed by non-Response File(s): '" <> intercalate "', '" nonResponseFileNames <> "'" - putStrLn $ "When first argument is a Response File, " <> - "all arguments should be Response Files." - exitFailure - let - responseFileNames :: NonEmpty FilePath - responseFileNames = firstResponseFileName :| responseFileNames' - - forM_ responseFileNames $ \responseFileName -> do - exists <- doesPathExist responseFileName - when (not exists) $ do - putStrLn $ "Response File '" <> responseFileName <> "' does not exist" - exitFailure - - -- read all Response Files - responseFileNamesAndText :: NonEmpty (FilePath, String) <- - forM responseFileNames $ \responseFileName -> - fmap (responseFileName, ) (readFile responseFileName) - forM_ responseFileNamesAndText $ \(responseFileName, responseFileText) -> - -- parse first word of Response File, which should be a command - case uncons $ words responseFileText of - Nothing -> do - putStrLn $ "Response File '" <> responseFileName <> "' has no command" - exitFailure - Just (responseFileCommand, args1) -> case lookup responseFileCommand hooks' of - -- check command for validity - -- It is important than a Response File cannot specify another Response File; - -- this is prevented - Nothing -> do - putStrLn $ "Response File '" <> responseFileName <> - "' command '" <> responseFileCommand <> "' invalid" - exitFailure - Just plugin -> do - putStrLn $ "Response File '" <> responseFileName <> "':" - parse plugin args1 - - where - getResponseFileName :: String -> Maybe FilePath - getResponseFileName s = do - (firstChar, filename) <- uncons s - if firstChar == '@' - then pure filename - else Nothing - - -- first member of tuple is list of Response File names, - -- second member of tuple is list of all other arguments - partitionFileNames :: [String] -> ([FilePath], [String]) - partitionFileNames xs = let - hasFileName :: [(String, Maybe FilePath)] - hasFileName = fmap (\x -> (x, getResponseFileName x)) xs - (fileNames, nonFileNames) :: ([Maybe FilePath], [String]) = - bimap (fmap snd) (fmap fst) $ partition (isJust . snd) hasFileName - in (catMaybes fileNames, nonFileNames) - - parse plugin args = - case getOpt Permute (options plugin []) args of - (_,_,errs) | not (null errs) - -> do putStrLn "hpc failed:" - sequence_ [ putStr (" " ++ err) - | err <- errs - ] - putStrLn $ "\n" - command_usage plugin - exitFailure - (o,ns,_) -> do - let flags = final_flags plugin - . foldr (.) id o - $ init_flags plugin - implementation plugin flags ns - -main :: IO () -main = do - args <- getArgs - dispatch args - ------------------------------------------------------------------------------- - -hooks :: [Plugin] -hooks = [ help_plugin - , report_plugin - , markup_plugin - , sum_plugin - , combine_plugin - , map_plugin - , showtix_plugin - , overlay_plugin - , draft_plugin - , version_plugin - ] - -hooks' :: [(String, Plugin)] -hooks' = [ (name hook,hook) | hook <- hooks ] - ------------------------------------------------------------------------------- - -help_plugin :: Plugin -help_plugin = Plugin { name = "help" - , usage = "[]" - , summary = "Display help for hpc or a single command" - , options = help_options - , implementation = help_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -help_main :: Flags -> [String] -> IO () -help_main _ [] = do - helpList - exitWith ExitSuccess -help_main _ (sub_txt:_) = do - case lookup sub_txt hooks' of - Nothing -> do - putStrLn $ "no such HPC command: " <> sub_txt - exitFailure - Just plugin' -> do - command_usage plugin' - exitWith ExitSuccess - -help_options :: FlagOptSeq -help_options = id - ------------------------------------------------------------------------------- - -version_plugin :: Plugin -version_plugin = Plugin { name = "version" - , usage = "" - , summary = "Display version for hpc" - , options = id - , implementation = version_main - , init_flags = default_flags - , final_flags = default_final_flags - } - -version_main :: Flags -> [String] -> IO () -version_main _ _ = putStrLn ("hpc tools, version " ++ showVersion version) - - ------------------------------------------------------------------------------- ===================================== utils/hpc/Makefile deleted ===================================== @@ -1,15 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -dir = utils/hpc -TOP = ../.. -include $(TOP)/mk/sub-makefile.mk ===================================== utils/hpc/hpc-bin.cabal deleted ===================================== @@ -1,44 +0,0 @@ -Name: hpc-bin --- XXX version number: -Version: 0.68 -Copyright: XXX -License: BSD3 --- XXX License-File: LICENSE -Author: XXX -Maintainer: XXX -Synopsis: XXX -Description: XXX -Category: Development -build-type: Simple -cabal-version: 2.0 - -Flag build-tool-depends - Description: Use build-tool-depends - Default: True - -Executable hpc - Default-Language: Haskell2010 - Main-Is: Main.hs - Other-Modules: HpcParser - HpcCombine - HpcDraft - HpcFlags - HpcLexer - HpcMarkup - HpcOverlay - HpcReport - HpcShowTix - HpcUtils - Paths_hpc_bin - - autogen-modules: Paths_hpc_bin - - Build-Depends: base >= 4 && < 5, - directory >= 1 && < 1.4, - filepath >= 1 && < 1.5, - containers >= 0.1 && < 0.7, - array >= 0.1 && < 0.6, - hpc >= 0.6.1 && < 0.7 - - if flag(build-tool-depends) - build-tool-depends: happy:happy >= 1.20.0 ===================================== utils/hpc/hpc.wrapper deleted ===================================== @@ -1,2 +0,0 @@ -#!/bin/sh -exec "$executablename" ${1+"$@"} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4cacd04265bc8a210f0c1ff5ee156b937bbfcd26...b140966379c6938dea3e53b39f0783517cb17bff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4cacd04265bc8a210f0c1ff5ee156b937bbfcd26...b140966379c6938dea3e53b39f0783517cb17bff You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 13:59:20 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Mar 2023 08:59:20 -0500 Subject: [Git][ghc/ghc][master] Change hostSupportsRPaths to report False on OpenBSD Message-ID: <640894b882557_2c78e91d6ecc0c4515e8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - 1 changed file: - hadrian/src/Oracles/Setting.hs Changes: ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -293,7 +293,10 @@ isElfTarget = anyTargetOs elfOSes -- TODO: Windows supports lazy binding (but GHC doesn't currently support -- dynamic way on Windows anyways). hostSupportsRPaths :: Action Bool -hostSupportsRPaths = anyHostOs (elfOSes ++ machoOSes) +hostSupportsRPaths = do + -- https://gitlab.haskell.org/ghc/ghc/-/issues/23011 + isOpenBSD <- anyHostOs ["openbsd"] + if not isOpenBSD then anyHostOs (elfOSes ++ machoOSes) else pure False -- | Check whether the target supports GHCi. ghcWithInterpreter :: Action Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 14:00:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Mar 2023 09:00:16 -0500 Subject: [Git][ghc/ghc][master] bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args Message-ID: <640894f0eb35c_2c78e91db540744568e0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 6 changed files: - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/StgToByteCode.hs - + testsuite/tests/bytecode/T23068.hs - + testsuite/tests/bytecode/T23068.script - + testsuite/tests/bytecode/T23068.stdout - + testsuite/tests/bytecode/all.T Changes: ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -funbox-strict-fields #-} -- -- (c) The University of Glasgow 2002-2006 @@ -354,7 +355,10 @@ instance Outputable BCInstr where ppr RETURN = text "RETURN" ppr (RETURN_UNLIFTED pk) = text "RETURN_UNLIFTED " <+> ppr pk ppr (RETURN_TUPLE) = text "RETURN_TUPLE" - ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> ppr uniq <+> text "" + ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> mb_uniq <+> text "" + where mb_uniq = sdocOption sdocSuppressUniques $ \case + True -> text "" + False -> ppr uniq ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -486,8 +486,7 @@ returnUnliftedReps d s szb reps = do -- otherwise use RETURN_TUPLE with a tuple descriptor nv_reps -> do let (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 (primRepCmmType platform) nv_reps - args_ptrs = map (\(rep, off) -> (isFollowableArg (toArgRep platform rep), off)) args_offsets - tuple_bco <- emitBc (tupleBCO platform call_info args_ptrs) + tuple_bco <- emitBc (tupleBCO platform call_info args_offsets) return $ PUSH_UBX (mkNativeCallInfoLit platform call_info) 1 `consOL` PUSH_BCO tuple_bco `consOL` unitOL RETURN_TUPLE @@ -1050,13 +1049,9 @@ doCase d s p scrut bndr alts p scrut alt_bco' <- emitBc alt_bco if ubx_tuple_frame - then do - let args_ptrs = - map (\(rep, off) -> (isFollowableArg (toArgRep platform rep), off)) - args_offsets - tuple_bco <- emitBc (tupleBCO platform call_info args_ptrs) - return (PUSH_ALTS_TUPLE alt_bco' call_info tuple_bco - `consOL` scrut_code) + then do tuple_bco <- emitBc (tupleBCO platform call_info args_offsets) + return (PUSH_ALTS_TUPLE alt_bco' call_info tuple_bco + `consOL` scrut_code) else let push_alts | not ubx_frame = PUSH_ALTS alt_bco' @@ -1244,11 +1239,10 @@ usePlainReturn t -} -tupleBCO :: Platform -> NativeCallInfo -> [(Bool, ByteOff)] -> [FFIInfo] -> ProtoBCO Name -tupleBCO platform info pointers = +tupleBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name +tupleBCO platform args_info args = mkProtoBCO platform invented_name body_code (Left []) 0{-no arity-} bitmap_size bitmap False{-is alts-} - where {- The tuple BCO is never referred to by name, so we can get away @@ -1260,18 +1254,16 @@ tupleBCO platform info pointers = -- the first word in the frame is the call_info word, -- which is not a pointer - bitmap_size = trunc16W $ 1 + nativeCallSize info - bitmap = intsToReverseBitmap platform (fromIntegral bitmap_size) $ - map ((+1) . fromIntegral . bytesToWords platform . snd) - (filter fst pointers) + nptrs_prefix = 1 + (bitmap_size, bitmap) = mkStackBitmap platform nptrs_prefix args_info args + body_code = mkSlideW 0 1 -- pop frame header `snocOL` RETURN_TUPLE -- and add it again -primCallBCO :: Platform -> NativeCallInfo -> [(Bool, ByteOff)] -> [FFIInfo] -> ProtoBCO Name -primCallBCO platform args_info pointers = +primCallBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name +primCallBCO platform args_info args = mkProtoBCO platform invented_name body_code (Left []) 0{-no arity-} bitmap_size bitmap False{-is alts-} - where {- The primcall BCO is never referred to by name, so we can get away @@ -1281,20 +1273,52 @@ primCallBCO platform args_info pointers = -} invented_name = mkSystemVarName (mkPseudoUniqueE 0) (fsLit "primcall") - -- the first three words in the frame are the BCO describing the - -- pointers in the frame, the call_info word and the pointer - -- to the Cmm function being called. None of these is a pointer that - -- should be followed by the garbage collector - bitmap_size = trunc16W $ 2 + nativeCallSize args_info - bitmap = intsToReverseBitmap platform (fromIntegral bitmap_size) $ - map ((+2) . fromIntegral . bytesToWords platform . snd) - (filter fst pointers) + -- The first two words in the frame (after the BCO) are the call_info word + -- and the pointer to the Cmm function being called. Neither of these is a + -- pointer that should be followed by the garbage collector. + nptrs_prefix = 2 + (bitmap_size, bitmap) = mkStackBitmap platform nptrs_prefix args_info args + -- if the primcall BCO is ever run it's a bug, since the BCO should only -- be pushed immediately before running the PRIMCALL bytecode instruction, -- which immediately leaves the interpreter to jump to the stg_primcall_info -- Cmm function body_code = unitOL CASEFAIL +-- | Builds a bitmap for a stack layout with a nonpointer prefix followed by +-- some number of arguments. +mkStackBitmap + :: Platform + -> WordOff + -- ^ The number of nonpointer words that prefix the arguments. + -> NativeCallInfo + -> [(PrimRep, ByteOff)] + -- ^ The stack layout of the arguments, where each offset is relative to the + -- /bottom/ of the stack space they occupy. Their offsets must be word-aligned, + -- and the list must be sorted in order of ascending offset (i.e. bottom to top). + -> (Word16, [StgWord]) +mkStackBitmap platform nptrs_prefix args_info args + = (bitmap_size, bitmap) + where + bitmap_size = trunc16W $ nptrs_prefix + arg_bottom + bitmap = intsToReverseBitmap platform (fromIntegral bitmap_size) ptr_offsets + + arg_bottom = nativeCallSize args_info + ptr_offsets = reverse $ map (fromIntegral . convert_arg_offset) + $ mapMaybe get_ptr_offset args + + get_ptr_offset :: (PrimRep, ByteOff) -> Maybe ByteOff + get_ptr_offset (rep, byte_offset) + | isFollowableArg (toArgRep platform rep) = Just byte_offset + | otherwise = Nothing + + convert_arg_offset :: ByteOff -> WordOff + convert_arg_offset arg_offset = + -- The argument offsets are relative to `arg_bottom`, but + -- `intsToReverseBitmap` expects offsets from the top, so we need to flip + -- them around. + nptrs_prefix + (arg_bottom - bytesToWords platform arg_offset) + -- ----------------------------------------------------------------------------- -- Deal with a primitive call to native code. @@ -1322,15 +1346,12 @@ generatePrimCall d s p target _mb_unit _result_ty args (args_info, args_offsets) = layoutNativeCall profile NativePrimCall - d + 0 (primRepCmmType platform . argPrimRep) nv_args - args_ptrs :: [(Bool, ByteOff)] - args_ptrs = - map (\(r, off) -> - (isFollowableArg (toArgRep platform . argPrimRep $ r), off)) - args_offsets + prim_args_offsets = mapFst argPrimRep args_offsets + shifted_args_offsets = mapSnd (+ d) args_offsets push_target = PUSH_UBX (LitLabel target Nothing IsFunction) 1 push_info = PUSH_UBX (mkNativeCallInfoLit platform args_info) 1 @@ -1347,8 +1368,8 @@ generatePrimCall d s p target _mb_unit _result_ty args go !dd pushes ((a, off):cs) = do (push, szb) <- pushAtom dd p a massert (off == dd + szb) go (dd + szb) (push:pushes) cs - push_args <- go d [] args_offsets - args_bco <- emitBc (primCallBCO platform args_info args_ptrs) + push_args <- go d [] shifted_args_offsets + args_bco <- emitBc (primCallBCO platform args_info prim_args_offsets) return $ mconcat push_args `appOL` (push_target `consOL` push_info `consOL` ===================================== testsuite/tests/bytecode/T23068.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +module T23068 where +import GHC.Exts + +f :: () -> (# Int, Int #) +f () = (# 0, 0 #) + +g :: () -> (# Int#, Int#, Int #) +g () = (# 0#, 0#, 0 #) ===================================== testsuite/tests/bytecode/T23068.script ===================================== @@ -0,0 +1 @@ +:l T23068 ===================================== testsuite/tests/bytecode/T23068.stdout ===================================== @@ -0,0 +1,71 @@ + +==================== Proto-BCOs ==================== +ProtoBCO T23068.g#1 []: + \r [ds] case of wild + bitmap: 1 [0] + PUSH_ALTS P + ProtoBCO wild#0 []: + { () -> let bcprep = ... in ... + bitmap: 1 [0] + ALLOC_PAP 1 0 + PUSH_BCO + ProtoBCO bcprep#1 []: + \r [void] break<0>() let sat = ... in ... + bitmap: 0 [] + BRK_FUN 0 + PUSH_UBX (1) 0# + PACK GHC.Types.I# 1 + PUSH_L 0 + PUSH_UBX (1) 0# + PUSH_UBX (1) 0# + SLIDE 3 1 + PUSH_UBX (1) 7## + PUSH_BCO + ProtoBCO tuple#0 []: + bitmap: 4 [7] + SLIDE 0 1 + RETURN_TUPLE + RETURN_TUPLE + MKPAP 0 words, 1 stkoff + PUSH_APPLY_V + PUSH_L 1 + SLIDE 2 5 + ENTER + PUSH_L 2 + ENTER + +ProtoBCO T23068.f#1 []: + \r [ds] case of wild + bitmap: 1 [0] + PUSH_ALTS P + ProtoBCO wild#0 []: + { () -> let bcprep = ... in ... + bitmap: 1 [0] + ALLOC_PAP 1 0 + PUSH_BCO + ProtoBCO bcprep#1 []: + \r [void] break<1>() let sat = ... in ... + bitmap: 0 [] + BRK_FUN 1 + PUSH_UBX (1) 0# + PACK GHC.Types.I# 1 + PUSH_UBX (1) 0# + PACK GHC.Types.I# 1 + PUSH_LL 1 0 + SLIDE 2 2 + PUSH_UBX (1) 3## + PUSH_BCO + ProtoBCO tuple#0 []: + bitmap: 3 [1] + SLIDE 0 1 + RETURN_TUPLE + RETURN_TUPLE + MKPAP 0 words, 1 stkoff + PUSH_APPLY_V + PUSH_L 1 + SLIDE 2 5 + ENTER + PUSH_L 2 + ENTER + + ===================================== testsuite/tests/bytecode/all.T ===================================== @@ -0,0 +1,3 @@ +ghci_dump_bcos = [only_ways(['ghci']), extra_run_opts('-dno-typeable-binds -dsuppress-uniques -ddump-bcos')] + +test('T23068', ghci_dump_bcos + [filter_stdout_lines(r'.*bitmap: .*')], ghci_script, ['T23068.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bed3a292df532935426987e1f0c5eaa4f605407e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bed3a292df532935426987e1f0c5eaa4f605407e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 14:05:50 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Wed, 08 Mar 2023 09:05:50 -0500 Subject: [Git][ghc/ghc][wip/T22997] DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) Message-ID: <6408963ebfa0a_2c78e91dc5a5e0459196@gitlab.mail> Sebastian Graf pushed to branch wip/T22997 at Glasgow Haskell Compiler / GHC Commits: e607d32d by Sebastian Graf at 2023-03-08T15:04:20+01:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 3 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - + testsuite/tests/stranal/should_compile/T22997.hs - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1916,10 +1916,11 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- Check for an OPAQUE function: see Note [OPAQUE pragma] -- In that case, trim off all boxity info from argument demands + -- and demand info on lambda binders -- See Note [The OPAQUE pragma and avoiding the reboxing of arguments] | isOpaquePragma (idInlinePragma fn) , let trimmed_rhs_dmds = map trimBoxity rhs_dmds - = (trimmed_rhs_dmds, add_demands trimmed_rhs_dmds rhs) + = (trimmed_rhs_dmds, set_lam_dmds trimmed_rhs_dmds rhs) -- Check that we have enough visible binders to match the -- threshold arity; if not, we won't do worker/wrapper @@ -1939,8 +1940,8 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- vcat [text "function:" <+> ppr fn -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ - (arg_dmds', add_demands arg_dmds' rhs) - -- add_demands: we must attach the final boxities to the lambda-binders + (arg_dmds', set_lam_dmds arg_dmds' rhs) + -- set_lam_dmds: we must attach the final boxities to the lambda-binders -- of the function, both because that's kosher, and because CPR analysis -- uses the info on the binders directly. where @@ -2032,17 +2033,18 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs | positiveTopBudget bg_inner' = (bg_inner', dmd') | otherwise = (bg_inner, trimBoxity dmd) - add_demands :: [Demand] -> CoreExpr -> CoreExpr + set_lam_dmds :: [Demand] -> CoreExpr -> CoreExpr -- Attach the demands to the outer lambdas of this expression - add_demands [] e = e - add_demands (dmd:dmds) (Lam v e) - | isTyVar v = Lam v (add_demands (dmd:dmds) e) - | otherwise = Lam (v `setIdDemandInfo` dmd) (add_demands dmds e) - add_demands dmds (Cast e co) = Cast (add_demands dmds e) co + set_lam_dmds (dmd:dmds) (Lam v e) + | isTyVar v = Lam v (set_lam_dmds (dmd:dmds) e) + | otherwise = Lam (v `setIdDemandInfo` dmd) (set_lam_dmds dmds e) + set_lam_dmds dmds (Cast e co) = Cast (set_lam_dmds dmds e) co -- This case happens for an OPAQUE function, which may look like -- f = (\x y. blah) |> co -- We give it strictness but no boxity (#22502) - add_demands dmds e = pprPanic "add_demands" (ppr dmds $$ ppr e) + set_lam_dmds _ e = e + -- In the OPAQUE case, the list of demands at this point might be + -- non-empty, e.g., when looking at a PAP. Hence don't panic (#22997). finaliseLetBoxity :: AnalEnv ===================================== testsuite/tests/stranal/should_compile/T22997.hs ===================================== @@ -0,0 +1,9 @@ +module T22997 where + +{-# OPAQUE trivial #-} +trivial :: Int -> Int +trivial = succ + +{-# OPAQUE pap #-} +pap :: Integer -> Integer +pap = (42 +) ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -88,3 +88,5 @@ test('EtaExpansion', normal, compile, ['']) test('T22039', normal, compile, ['']) # T22388: Should see $winteresting but not $wboring test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) +# T22997: Just a panic that should not happen +test('T22997', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e607d32d44bd82901f3f12012f5838469221b649 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e607d32d44bd82901f3f12012f5838469221b649 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 16:27:23 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Wed, 08 Mar 2023 11:27:23 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/supersven/ghc-correct-fun-type-Cmm Message-ID: <6408b76b90a38_2c78e9206c3610495075@gitlab.mail> Sven Tennie pushed new branch wip/supersven/ghc-correct-fun-type-Cmm at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/supersven/ghc-correct-fun-type-Cmm You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 16:50:52 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 08 Mar 2023 11:50:52 -0500 Subject: [Git][ghc/ghc][wip/ghc-with-debug] 963 commits: Fix arityType: -fpedantic-bottoms, join points, etc Message-ID: <6408bcec972ba_2c78e920ce5cdc50052f@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-with-debug at Glasgow Haskell Compiler / GHC Commits: a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * For #21694 the underlying problem was that we were calling arityType on an expression that had free join points. This is a Bad Bad Idea. See Note [No free join points in arityType]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_sigs giving the ArityType for let-bound Ids, we don't need the (pre-dating) special code in arityType for join points. But instead we need to extend the env for Rec bindings, which weren't doing before. More uniform now. See Note [arityType for let-bindings]. This meant we could get rid of ae_joins, and in fact get rid of EtaExpandArity altogether. Simpler. * And finally, it was the strange treatment of join-point Ids in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% I had a quick look at T18223 but it is knee deep in coercions and the size of everything looks similar before and after. I decided to accept that 3% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 0154bc80 by sheaf at 2022-08-30T06:05:41-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 451b1d90 by Matthew Pickering at 2022-08-30T06:06:16-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 9d5ad7c4 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: stray "--" - - - - - 3a002632 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: syntatic -> syntactic - - - - - 7f490b13 by Simon Peyton Jones at 2022-08-31T03:53:54-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - e6fc820f by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump binary submodule to 0.8.9.1 - - - - - 4c1e7b22 by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump stm submodule to 2.5.1.0 - - - - - 837472b4 by Ben Gamari at 2022-08-31T13:16:01+01:00 users-guide: Document system-cxx-std-lib - - - - - f7a9947a by Douglas Wilson at 2022-08-31T13:16:01+01:00 Update submodule containers to 0.6.6 - - - - - 4ab1c2ca by Douglas Wilson at 2022-08-31T13:16:02+01:00 Update submodule process to 1.6.15.0 - - - - - 1309ea1e by Ben Gamari at 2022-08-31T13:16:02+01:00 Bump directory submodule to 1.3.7.1 - - - - - 7962a33a by Douglas Wilson at 2022-08-31T13:16:02+01:00 Bump text submodule to 2.0.1 - - - - - fd8d80c3 by Ben Gamari at 2022-08-31T13:26:52+01:00 Bump deepseq submodule to 1.4.8.0 - - - - - a9baafac by Ben Gamari at 2022-08-31T13:26:52+01:00 Add dates to base, ghc-prim changelogs - - - - - 2cee323c by Ben Gamari at 2022-08-31T13:26:52+01:00 Update autoconf scripts Scripts taken from autoconf 02ba26b218d3d3db6c56e014655faf463cefa983 - - - - - e62705ff by Ben Gamari at 2022-08-31T13:26:53+01:00 Bump bytestring submodule to 0.11.3.1 - - - - - f7b4dcbd by Douglas Wilson at 2022-08-31T13:26:53+01:00 Update submodule Cabal to tag Cabal-v3.8.1.0 closes #21931 - - - - - e8eaf807 by Matthew Pickering at 2022-08-31T18:27:57-04:00 Refine in-tree compiler args for --test-compiler=stage1 Some of the logic to calculate in-tree arguments was not correct for the stage1 compiler. Namely we were not correctly reporting whether we were building static or dynamic executables and whether debug assertions were enabled. Fixes #22096 - - - - - 6b2f7ffe by Matthew Pickering at 2022-08-31T18:27:57-04:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 15111af6 by Zubin Duggal at 2022-09-01T01:18:50-04:00 Add regression test for #21550 This was fixed by ca90ffa321a31842a32be1b5b6e26743cd677ec5 "Use local instances with least superclass depth" - - - - - 7d3a055d by Krzysztof Gogolewski at 2022-09-01T01:19:26-04:00 Minor cleanup - Remove mkHeteroCoercionType, sdocImpredicativeTypes, isStateType (unused), isCoVar_maybe (duplicated by getCoVar_maybe) - Replace a few occurrences of voidPrimId with (# #). void# is a deprecated synonym for the unboxed tuple. - Use showSDoc in :show linker. This makes it consistent with the other :show commands - - - - - 31a8989a by Tommy Bidne at 2022-09-01T12:01:20-04:00 Change Ord defaults per CLC proposal Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/24#issuecomment-1233331267 - - - - - 7f527f01 by Matthew Pickering at 2022-09-01T12:01:56-04:00 Fix bootstrap with ghc-9.0 It turns out Solo is a very recent addition to base, so for older GHC versions we just defined it inline here the one place we use it in the compiler. - - - - - d2be80fd by Sebastian Graf at 2022-09-05T23:12:14-04:00 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. - - - - - 25f68ace by Ben Gamari at 2022-09-05T23:12:50-04:00 gitlab-ci: Ensure that ghc derivation is in scope Previously the lint-ci job attempted to use cabal-install (specifically `cabal update`) without a GHC in PATH. However, cabal-install-3.8 appears to want GHC, even for `cabal update`. - - - - - f37b621f by sheaf at 2022-09-06T11:51:53+00:00 Update instances.rst, clarifying InstanceSigs Fixes #22103 - - - - - d4f908f7 by Jan Hrček at 2022-09-06T15:36:58-04:00 Fix :add docs in user guide - - - - - 808bb793 by Cheng Shao at 2022-09-06T15:37:35-04:00 ci: remove unused build_make/test_make in ci script - - - - - d0a2efb2 by Eric Lindblad at 2022-09-07T16:42:45-04:00 typo - - - - - fac0098b by Eric Lindblad at 2022-09-07T16:42:45-04:00 typos - - - - - a581186f by Eric Lindblad at 2022-09-07T16:42:45-04:00 whitespace - - - - - 04a738cb by Cheng Shao at 2022-09-07T16:43:22-04:00 CmmToAsm: remove unused ModLocation from NatM_State - - - - - ee1cfaa9 by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Minor SDoc cleanup Change calls to renderWithContext with showSDocOneLine; it's more efficient and explanatory. Remove polyPatSig (unused) - - - - - 7918265d by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Remove Outputable Char instance Use 'text' instead of 'ppr'. Using 'ppr' on the list "hello" rendered as "h,e,l,l,o". - - - - - 77209ab3 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Export liftA2 from Prelude Changes: In order to be warning free and compatible, we hide Applicative(..) from Prelude in a few places and instead import it directly from Control.Applicative. Please see the migration guide at https://github.com/haskell/core-libraries-committee/blob/main/guides/export-lifta2-prelude.md for more details. This means that Applicative is now exported in its entirety from Prelude. Motivation: This change is motivated by a few things: * liftA2 is an often used function, even more so than (<*>) for some people. * When implementing Applicative, the compiler will prompt you for either an implementation of (<*>) or of liftA2, but trying to use the latter ends with an error, without further imports. This could be confusing for newbies. * For teaching, it is often times easier to introduce liftA2 first, as it is a natural generalisation of fmap. * This change seems to have been unanimously and enthusiastically accepted by the CLC members, possibly indicating a lot of love for it. * This change causes very limited breakage, see the linked issue below for an investigation on this. See https://github.com/haskell/core-libraries-committee/issues/50 for the surrounding discussion and more details. - - - - - 442a94e8 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Add changelog entry for liftA2 export from Prelude - - - - - fb968680 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule containers to one with liftA2 warnings fixed - - - - - f54ff818 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule Cabal to one with liftA2 warnings fixed - - - - - a4b34808 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Isolate some Applicative hidings to GHC.Prelude By reexporting the entirety of Applicative from GHC.Prelude, we can save ourselves some `hiding` and importing of `Applicative` in consumers of GHC.Prelude. This also has the benefit of isolating this type of change to GHC.Prelude, so that people in the future don't have to think about it. - - - - - 9c4ea90c by Cheng Shao at 2022-09-08T17:49:47-04:00 CmmToC: enable 64-bit CallishMachOp on 32-bit targets Normally, the unregisterised builds avoid generating 64-bit CallishMachOp in StgToCmm, so CmmToC doesn't support these. However, there do exist cases where we'd like to invoke cmmToC for other cmm inputs which may contain such CallishMachOps, and it's a rather low effort to add support for these since they only require calling into existing ghc-prim cbits. - - - - - 04062510 by Alexis King at 2022-09-11T11:30:32+02:00 Add native delimited continuations to the RTS This patch implements GHC proposal 313, "Delimited continuation primops", by adding native support for delimited continuations to the GHC RTS. All things considered, the patch is relatively small. It almost exclusively consists of changes to the RTS; the compiler itself is essentially unaffected. The primops come with fairly extensive Haddock documentation, and an overview of the implementation strategy is given in the Notes in rts/Continuation.c. This first stab at the implementation prioritizes simplicity over performance. Most notably, every continuation is always stored as a single, contiguous chunk of stack. If one of these chunks is particularly large, it can result in poor performance, as the current implementation does not attempt to cleverly squeeze a subset of the stack frames into the existing stack: it must fit all at once. If this proves to be a performance issue in practice, a cleverer strategy would be a worthwhile target for future improvements. - - - - - ee471dfb by Cheng Shao at 2022-09-12T07:07:33-04:00 rts: fix missing dirty_MVAR argument in stg_writeIOPortzh - - - - - a5f9c35f by Cheng Shao at 2022-09-12T13:29:05-04:00 ci: enable parallel compression for xz - - - - - 3a815f30 by Ryan Scott at 2022-09-12T13:29:41-04:00 Windows: Always define _UCRT when compiling C code As seen in #22159, this is required to ensure correct behavior when MinGW-w64 headers are in the `C_INCLUDE_PATH`. Fixes #22159. - - - - - 65a0bd69 by sheaf at 2022-09-13T10:27:52-04:00 Add diagnostic codes This MR adds diagnostic codes, assigning unique numeric codes to error and warnings, e.g. error: [GHC-53633] Pattern match is redundant This is achieved as follows: - a type family GhcDiagnosticCode that gives the diagnostic code for each diagnostic constructor, - a type family ConRecursInto that specifies whether to recur into an argument of the constructor to obtain a more fine-grained code (e.g. different error codes for different 'deriving' errors), - generics machinery to generate the value-level function assigning each diagnostic its error code; see Note [Diagnostic codes using generics] in GHC.Types.Error.Codes. The upshot is that, to add a new diagnostic code, contributors only need to modify the two type families mentioned above. All logic relating to diagnostic codes is thus contained to the GHC.Types.Error.Codes module, with no code duplication. This MR also refactors error message datatypes a bit, ensuring we can derive Generic for them, and cleans up the logic around constraint solver reports by splitting up 'TcSolverReportInfo' into separate datatypes (see #20772). Fixes #21684 - - - - - 362cca13 by sheaf at 2022-09-13T10:27:53-04:00 Diagnostic codes: acccept test changes The testsuite output now contains diagnostic codes, so many tests need to be updated at once. We decided it was best to keep the diagnostic codes in the testsuite output, so that contributors don't inadvertently make changes to the diagnostic codes. - - - - - 08f6730c by Adam Gundry at 2022-09-13T10:28:29-04:00 Allow imports to reference multiple fields with the same name (#21625) If a module `M` exports two fields `f` (using DuplicateRecordFields), we can still accept import M (f) import M hiding (f) and treat `f` as referencing both of them. This was accepted in GHC 9.0, but gave rise to an ambiguity error in GHC 9.2. See #21625. This patch also documents this behaviour in the user's guide, and updates the test for #16745 which is now treated differently. - - - - - c14370d7 by Cheng Shao at 2022-09-13T10:29:07-04:00 ci: remove unused appveyor config - - - - - dc6af9ed by Cheng Shao at 2022-09-13T10:29:45-04:00 compiler: remove unused lazy state monad - - - - - 646d15ad by Eric Lindblad at 2022-09-14T03:13:56-04:00 Fix typos This fixes various typos and spelling mistakes in the compiler. Fixes #21891 - - - - - 7d7e71b0 by Matthew Pickering at 2022-09-14T03:14:32-04:00 hadrian: Bump index state This bumps the index state so a build plan can also be found when booting with 9.4. Fixes #22165 - - - - - 98b62871 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Use a stamp file to record when a package is built in a certain way Before this patch which library ways we had built wasn't recorded directly. So you would run into issues if you build the .conf file with some library ways before switching the library ways which you wanted to build. Now there is one stamp file for each way, so in order to build a specific way you can need that specific stamp file rather than going indirectly via the .conf file. - - - - - b42cedbe by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Inplace/Final package databases There are now two different package databases per stage. An inplace package database contains .conf files which point directly into the build directories. The final package database contains .conf files which point into the installed locations. The inplace .conf files are created before any building happens and have fake ABI hash values. The final .conf files are created after a package finished building and contains the proper ABI has. The motivation for this is to make the dependency structure more fine-grained when building modules. Now a module depends just depends directly on M.o from package p rather than the .conf file depend on the .conf file for package p. So when all of a modules direct dependencies have finished building we can start building it rather than waiting for the whole package to finish. The secondary motivation is that the multi-repl doesn't need to build everything before starting the multi-repl session. We can just configure the inplace package-db and use that in order to start the repl. - - - - - 6515c32b by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add some more packages to multi-cradle The main improvement here is to pass `-this-unit-id` for executables so that they can be added to the multi-cradle if desired as well as normal library packages. - - - - - e470e91f by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Need builders needed by Cabal Configure in parallel Because of the use of withStaged (which needs the necessary builder) when configuring a package, the builds of stage1:exe:ghc-bin and stage1:exe:ghc-pkg where being linearised when building a specific target like `binary-dist-dir`. Thankfully the fix is quite local, to supply all the `withStaged` arguments together so the needs can be batched together and hence performed in parallel. Fixes #22093 - - - - - c4438347 by Matthew Pickering at 2022-09-14T17:17:04-04:00 Remove stage1:exe:ghc-bin pre-build from CI script CI builds stage1:exe:ghc-bin before the binary-dist target which introduces some quite bad linearisation (see #22093) because we don't build stage1 compiler in parallel with anything. Then when the binary-dist target is started we have to build stage1:exe:ghc-pkg before doing anything. Fixes #22094 - - - - - 71d8db86 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add extra implicit dependencies from DeriveLift ghc -M should know that modules which use DeriveLift (or TemplateHaskellQuotes) need TH.Lib.Internal but until it does, we have to add these extra edges manually or the modules will be compiled before TH.Lib.Internal is compiled which leads to a desugarer error. - - - - - 43e574f0 by Greg Steuck at 2022-09-14T17:17:43-04:00 Repair c++ probing on OpenBSD Failure without this change: ``` checking C++ standard library flavour... libc++ checking for linkage against 'c++ c++abi'... failed checking for linkage against 'c++ cxxrt'... failed configure: error: Failed to find C++ standard library ``` - - - - - 534b39ee by Douglas Wilson at 2022-09-14T17:18:21-04:00 libraries: template-haskell: vendor filepath differently Vendoring with ../ in hs-source-dirs prevents upload to hackage. (cherry picked from commit 1446be7586ba70f9136496f9b67f792955447842) - - - - - bdd61cd6 by M Farkas-Dyck at 2022-09-14T22:39:34-04:00 Unbreak Hadrian with Cabal 3.8. - - - - - df04d6ec by Krzysztof Gogolewski at 2022-09-14T22:40:09-04:00 Fix typos - - - - - d6ea8356 by Andreas Klebinger at 2022-09-15T10:12:41+02:00 Tag inference: Fix #21954 by retaining tagsigs of vars in function position. For an expression like: case x of y Con z -> z If we also retain the tag sig for z we can generate code to immediately return it rather than calling out to stg_ap_0_fast. - - - - - 7cce7007 by Andreas Klebinger at 2022-09-15T10:12:42+02:00 Stg.InferTags.Rewrite - Avoid some thunks. - - - - - 88c4cbdb by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: enable -fprof-late only for profiling ways - - - - - d7235831 by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: add late_ccs flavour transformer - - - - - ce203753 by Cheng Shao at 2022-09-16T13:58:34-04:00 configure: remove unused program checks - - - - - 9b4c1056 by Pierre Le Marre at 2022-09-16T13:59:16-04:00 Update to Unicode 15.0 - - - - - c6e9b89a by Bodigrim at 2022-09-16T13:59:55-04:00 Avoid partial head and tail in ghc-heap; replace with total pattern-matching - - - - - 616afde3 by Cheng Shao at 2022-09-16T14:00:33-04:00 hadrian: relax Cabal upper bound to allow building with Cabal-3.8 A follow up of !8910. - - - - - df35d994 by Alexis King at 2022-09-16T14:01:11-04:00 Add links to the continuations haddocks in the docs for each primop fixes #22176 - - - - - 383f7549 by Matthew Pickering at 2022-09-16T21:42:10-04:00 -Wunused-pattern-binds: Recurse into patterns to check whether there's a splice See the examples in #22057 which show we have to traverse deeply into a pattern to determine whether it contains a splice or not. The original implementation pointed this out but deemed this very shallow traversal "too expensive". Fixes #22057 I also fixed an oversight in !7821 which meant we lost a warning which was present in 9.2.2. Fixes #22067 - - - - - 5031bf49 by sheaf at 2022-09-16T21:42:49-04:00 Hadrian: Don't try to build terminfo on Windows Commit b42cedbe introduced a dependency on terminfo on Windows, but that package isn't available on Windows. - - - - - c9afe221 by M Farkas-Dyck at 2022-09-17T06:44:47-04:00 Clean up some. In particular: • Delete some dead code, largely under `GHC.Utils`. • Clean up a few definitions in `GHC.Utils.(Misc, Monad)`. • Clean up `GHC.Types.SrcLoc`. • Derive stock `Functor, Foldable, Traversable` for more types. • Derive more instances for newtypes. Bump haddock submodule. - - - - - 85431ac3 by Cheng Shao at 2022-09-17T06:45:25-04:00 driver: pass original Cmm filename in ModLocation When compiling Cmm, the ml_hs_file field is used to indicate Cmm filename when later generating DWARF information. We should pass the original filename here, otherwise for preprocessed Cmm files, the filename will be a temporary filename which is confusing. - - - - - 63aa0069 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: remove legacy logging cabal flag - - - - - bd0f4184 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: make threaded ways optional For certain targets (e.g. wasm32-wasi), the threaded rts is known not to work. This patch adds a "threaded" cabal flag to rts to make threaded rts ways optional. Hadrian enables this flag iff the flavour rtsWays contains threaded ways. - - - - - 8a666ad2 by Ryan Scott at 2022-09-18T08:00:44-04:00 DeriveFunctor: Check for last type variables using dataConUnivTyVars Previously, derived instances of `Functor` (as well as the related classes `Foldable`, `Traversable`, and `Generic1`) would determine which constraints to infer by checking for fields that contain the last type variable. The problem was that this last type variable was taken from `tyConTyVars`. For GADTs, the type variables in each data constructor are _not_ the same type variables as in `tyConTyVars`, leading to #22167. This fixes the issue by instead checking for the last type variable using `dataConUnivTyVars`. (This is very similar in spirit to the fix for #21185, which also replaced an errant use of `tyConTyVars` with type variables from each data constructor.) Fixes #22167. - - - - - 78037167 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: pass updated buffer to actions (#22201) In the lexer, predicates have the following type: { ... } :: user -- predicate state -> AlexInput -- input stream before the token -> Int -- length of the token -> AlexInput -- input stream after the token -> Bool -- True <=> accept the token This is documented in the Alex manual. There is access to the input stream both before and after the token. But when the time comes to construct the token, GHC passes only the initial string buffer to the lexer action. This patch fixes it: - type Action = PsSpan -> StringBuffer -> Int -> P (PsLocated Token) + type Action = PsSpan -> StringBuffer -> Int -> StringBuffer -> P (PsLocated Token) Now lexer actions have access to the string buffer both before and after the token, just like the predicates. It's just a matter of passing an additional function parameter throughout the lexer. - - - - - 75746594 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: define varsym without predicates (#22201) Before this patch, the varsym lexing rules were defined as follows: <0> { @varsym / { precededByClosingToken `alexAndPred` followedByOpeningToken } { varsym_tight_infix } @varsym / { followedByOpeningToken } { varsym_prefix } @varsym / { precededByClosingToken } { varsym_suffix } @varsym { varsym_loose_infix } } Unfortunately, this meant that the predicates 'precededByClosingToken' and 'followedByOpeningToken' were recomputed several times before we could figure out the whitespace context. With this patch, we check for whitespace context directly in the lexer action: <0> { @varsym { with_op_ws varsym } } The checking for opening/closing tokens happens in 'with_op_ws' now, which is part of the lexer action rather than the lexer predicate. - - - - - c1f81b38 by M Farkas-Dyck at 2022-09-19T09:07:05-04:00 Scrub partiality about `NewOrData`. Rather than a list of constructors and a `NewOrData` flag, we define `data DataDefnCons a = NewTypeCon a | DataTypeCons [a]`, which enforces a newtype to have exactly one constructor. Closes #22070. Bump haddock submodule. - - - - - 1e1ed8c5 by Cheng Shao at 2022-09-19T09:07:43-04:00 CmmToC: emit __builtin_unreachable() after noreturn ccalls Emit a __builtin_unreachable() call after a foreign call marked as CmmNeverReturns. This is crucial to generate correctly typed code for wasm; as for other archs, this is also beneficial for the C compiler optimizations. - - - - - 19f45a25 by Jan Hrček at 2022-09-20T03:49:29-04:00 Document :unadd GHCi command in user guide - - - - - 545ff490 by sheaf at 2022-09-20T03:50:06-04:00 Hadrian: merge archives even in stage 0 We now always merge .a archives when ar supports -L. This change is necessary in order to bootstrap GHC using GHC 9.4 on Windows, as nested archives aren't supported. Not doing so triggered bug #21990 when trying to use the Win32 package, with errors such as: Not a x86_64 PE+ file. Unknown COFF 4 type in getHeaderInfo. ld.lld: error: undefined symbol: Win32zm2zi12zi0zi0_SystemziWin32ziConsoleziCtrlHandler_withConsoleCtrlHandler1_info We have to be careful about which ar is meant: in stage 0, the check should be done on the system ar (system-ar in system.config). - - - - - 59fe128c by Vladislav Zavialov at 2022-09-20T03:50:42-04:00 Fix -Woperator-whitespace for consym (part of #19372) Due to an oversight, the initial specification and implementation of -Woperator-whitespace focused on varsym exclusively and completely ignored consym. This meant that expressions such as "x+ y" would produce a warning, while "x:+ y" would not. The specification was corrected in ghc-proposals pull request #404, and this patch updates the implementation accordingly. Regression test included. - - - - - c4c2cca0 by John Ericson at 2022-09-20T13:11:49-04:00 Add `Eq` and `Ord` instances for `Generically1` These are needed so the subsequent commit overhauling the `*1` classes type-checks. - - - - - 7beb356e by John Ericson at 2022-09-20T13:11:50-04:00 Relax instances for Functor combinators; put superclass on Class1 and Class2 to make non-breaking This change is approved by the Core Libraries commitee in https://github.com/haskell/core-libraries-committee/issues/10 The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - 6a8c6b5e by Tom Ellis at 2022-09-20T13:12:27-04:00 Add notes to ghc-prim Haddocks that users should not import it - - - - - ee9d0f5c by matoro at 2022-09-20T13:13:06-04:00 docs: clarify that LLVM codegen is not available in unregisterised mode The current docs are misleading and suggest that it is possible to use LLVM codegen from an unregisterised build. This is not the case; attempting to pass `-fllvm` to an unregisterised build warns: ``` when making flags consistent: warning: Target platform uses unregisterised ABI, so compiling via C ``` and uses the C codegen anyway. - - - - - 854224ed by Nicolas Trangez at 2022-09-20T20:14:29-04:00 rts: remove copy-paste error from `cabal.rts.in` This was, likely accidentally, introduced in 4bf542bf1c. See: 4bf542bf1cdf2fa468457fc0af21333478293476 - - - - - c8ae3add by Matthew Pickering at 2022-09-20T20:15:04-04:00 hadrian: Add extra_dependencies edges for all different ways The hack to add extra dependencies needed by DeriveLift extension missed the cases for profiles and dynamic ways. For the profiled way this leads to errors like: ``` GHC error in desugarer lookup in Data.IntSet.Internal: Failed to load interface for ‘Language.Haskell.TH.Lib.Internal’ Perhaps you haven't installed the profiling libraries for package ‘template-haskell’? Use -v (or `:set -v` in ghci) to see a list of the files searched for. ghc: panic! (the 'impossible' happened) GHC version 9.5.20220916: initDs ``` Therefore the fix is to add these extra edges in. Fixes #22197 - - - - - a971657d by Mon Aaraj at 2022-09-21T06:41:24+03:00 users-guide: fix incorrect ghcappdata folder for unix and windows - - - - - 06ccad0d by sheaf at 2022-09-21T08:28:49-04:00 Don't use isUnliftedType in isTagged The function GHC.Stg.InferTags.Rewrite.isTagged can be given the Id of a join point, which might be representation polymorphic. This would cause the call to isUnliftedType to crash. It's better to use typeLevity_maybe instead. Fixes #22212 - - - - - c0ba775d by Teo Camarasu at 2022-09-21T14:30:37-04:00 Add fragmentation statistic to GHC.Stats Implements #21537 - - - - - 2463df2f by Torsten Schmits at 2022-09-21T14:31:24-04:00 Rename Solo[constructor] to MkSolo Part of proposal 475 (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst) Moves all tuples to GHC.Tuple.Prim Updates ghc-prim version (and bumps bounds in dependents) updates haddock submodule updates deepseq submodule updates text submodule - - - - - 9034fada by Matthew Pickering at 2022-09-22T09:25:29-04:00 Update filepath to filepath-1.4.100.0 Updates submodule * Always rely on vendored filepath * filepath must be built as stage0 dependency because it uses template-haskell. Towards #22098 - - - - - 615e2278 by Krzysztof Gogolewski at 2022-09-22T09:26:05-04:00 Minor refactor around Outputable * Replace 'text . show' and 'ppr' with 'int'. * Remove Outputable.hs-boot, no longer needed * Use pprWithCommas * Factor out instructions in AArch64 codegen - - - - - aeafdba5 by Sebastian Graf at 2022-09-27T15:14:54+02:00 Demand: Clear distinction between Call SubDmd and eval Dmd (#21717) In #21717 we saw a reportedly unsound strictness signature due to an unsound definition of plusSubDmd on Calls. This patch contains a description and the fix to the unsoundness as outlined in `Note [Call SubDemand vs. evaluation Demand]`. This fix means we also get rid of the special handling of `-fpedantic-bottoms` in eta-reduction. Thanks to less strict and actually sound strictness results, we will no longer eta-reduce the problematic cases in the first place, even without `-fpedantic-bottoms`. So fixing the unsoundness also makes our eta-reduction code simpler with less hacks to explain. But there is another, more unfortunate side-effect: We *unfix* #21085, but fortunately we have a new fix ready: See `Note [mkCall and plusSubDmd]`. There's another change: I decided to make `Note [SubDemand denotes at least one evaluation]` a lot simpler by using `plusSubDmd` (instead of `lubPlusSubDmd`) even if both argument demands are lazy. That leads to less precise results, but in turn rids ourselves from the need for 4 different `OpMode`s and the complication of `Note [Manual specialisation of lub*Dmd/plus*Dmd]`. The result is simpler code that is in line with the paper draft on Demand Analysis. I left the abandoned idea in `Note [Unrealised opportunity in plusDmd]` for posterity. The fallout in terms of regressions is negligible, as the testsuite and NoFib shows. ``` Program Allocs Instrs -------------------------------------------------------------------------------- hidden +0.2% -0.2% linear -0.0% -0.7% -------------------------------------------------------------------------------- Min -0.0% -0.7% Max +0.2% +0.0% Geometric Mean +0.0% -0.0% ``` Fixes #21717. - - - - - 9b1595c8 by Ross Paterson at 2022-09-27T14:12:01-04:00 implement proposal 106 (Define Kinds Without Promotion) (fixes #6024) includes corresponding changes to haddock submodule - - - - - c2d73cb4 by Andreas Klebinger at 2022-09-28T15:07:30-04:00 Apply some tricks to speed up core lint. Below are the noteworthy changes and if given their impact on compiler allocations for a type heavy module: * Use the oneShot trick on LintM * Use a unboxed tuple for the result of LintM: ~6% reduction * Avoid a thunk for the result of typeKind in lintType: ~5% reduction * lint_app: Don't allocate the error msg in the hot code path: ~4% reduction * lint_app: Eagerly force the in scope set: ~4% * nonDetCmpType: Try to short cut using reallyUnsafePtrEquality#: ~2% * lintM: Use a unboxed maybe for the `a` result: ~12% * lint_app: make go_app tail recursive to avoid allocating the go function as heap closure: ~7% * expandSynTyCon_maybe: Use a specialized data type For a less type heavy module like nofib/spectral/simple compiled with -O -dcore-lint allocations went down by ~24% and compile time by ~9%. ------------------------- Metric Decrease: T1969 ------------------------- - - - - - b74b6191 by sheaf at 2022-09-28T15:08:10-04:00 matchLocalInst: do domination analysis When multiple Given quantified constraints match a Wanted, and there is a quantified constraint that dominates all others, we now pick it to solve the Wanted. See Note [Use only the best matching quantified constraint]. For example: [G] d1: forall a b. ( Eq a, Num b, C a b ) => D a b [G] d2: forall a . C a Int => D a Int [W] {w}: D a Int When solving the Wanted, we find that both Givens match, but we pick the second, because it has a weaker precondition, C a Int, compared to (Eq a, Num Int, C a Int). We thus say that d2 dominates d1; see Note [When does a quantified instance dominate another?]. This domination test is done purely in terms of superclass expansion, in the function GHC.Tc.Solver.Interact.impliedBySCs. We don't attempt to do a full round of constraint solving; this simple check suffices for now. Fixes #22216 and #22223 - - - - - 2a53ac18 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Improve aggressive specialisation This patch fixes #21286, by not unboxing dictionaries in worker/wrapper (ever). The main payload is tiny: * In `GHC.Core.Opt.DmdAnal.finaliseArgBoxities`, do not unbox dictionaries in `get_dmd`. See Note [Do not unbox class dictionaries] in that module * I also found that imported wrappers were being fruitlessly specialised, so I fixed that too, in canSpecImport. See Note [Specialising imported functions] point (2). In doing due diligence in the testsuite I fixed a number of other things: * Improve Note [Specialising unfoldings] in GHC.Core.Unfold.Make, and Note [Inline specialisations] in GHC.Core.Opt.Specialise, and remove duplication between the two. The new Note describes how we specialise functions with an INLINABLE pragma. And simplify the defn of `spec_unf` in `GHC.Core.Opt.Specialise.specCalls`. * Improve Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. And (critially) make an actual change which is to propagate the user-written pragma from the original function to the wrapper; see `mkStrWrapperInlinePrag`. * Write new Note [Specialising imported functions] in GHC.Core.Opt.Specialise All this has a big effect on some compile times. This is compiler/perf, showing only changes over 1%: Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -50.2% GOOD ManyConstructors(normal) +1.0% MultiLayerModulesTH_OneShot(normal) +2.6% PmSeriesG(normal) -1.1% T10547(normal) -1.2% T11195(normal) -1.2% T11276(normal) -1.0% T11303b(normal) -1.6% T11545(normal) -1.4% T11822(normal) -1.3% T12150(optasm) -1.0% T12234(optasm) -1.2% T13056(optasm) -9.3% GOOD T13253(normal) -3.8% GOOD T15164(normal) -3.6% GOOD T16190(normal) -2.1% T16577(normal) -2.8% GOOD T16875(normal) -1.6% T17836(normal) +2.2% T17977b(normal) -1.0% T18223(normal) -33.3% GOOD T18282(normal) -3.4% GOOD T18304(normal) -1.4% T18698a(normal) -1.4% GOOD T18698b(normal) -1.3% GOOD T19695(normal) -2.5% GOOD T5837(normal) -2.3% T9630(normal) -33.0% GOOD WWRec(normal) -9.7% GOOD hard_hole_fits(normal) -2.1% GOOD hie002(normal) +1.6% geo. mean -2.2% minimum -50.2% maximum +2.6% I diligently investigated some of the big drops. * Caused by not doing w/w for dictionaries: T13056, T15164, WWRec, T18223 * Caused by not fruitlessly specialising wrappers LargeRecord, T9630 For runtimes, here is perf/should+_run: Metrics: runtime/bytes allocated -------------------------------- T12990(normal) -3.8% T5205(normal) -1.3% T9203(normal) -10.7% GOOD haddock.Cabal(normal) +0.1% haddock.base(normal) -1.1% haddock.compiler(normal) -0.3% lazy-bs-alloc(normal) -0.2% ------------------------------------------ geo. mean -0.3% minimum -10.7% maximum +0.1% I did not investigate exactly what happens in T9203. Nofib is a wash: +-------------------------------++--+-----------+-----------+ | || | tsv (rel) | std. err. | +===============================++==+===========+===========+ | real/anna || | -0.13% | 0.0% | | real/fem || | +0.13% | 0.0% | | real/fulsom || | -0.16% | 0.0% | | real/lift || | -1.55% | 0.0% | | real/reptile || | -0.11% | 0.0% | | real/smallpt || | +0.51% | 0.0% | | spectral/constraints || | +0.20% | 0.0% | | spectral/dom-lt || | +1.80% | 0.0% | | spectral/expert || | +0.33% | 0.0% | +===============================++==+===========+===========+ | geom mean || | | | +-------------------------------++--+-----------+-----------+ I spent quite some time investigating dom-lt, but it's pretty complicated. See my note on !7847. Conclusion: it's just a delicate inlining interaction, and we have plenty of those. Metric Decrease: LargeRecord T13056 T13253 T15164 T16577 T18223 T18282 T18698a T18698b T19695 T9630 WWRec hard_hole_fits T9203 - - - - - addeefc0 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Refactor UnfoldingSource and IfaceUnfolding I finally got tired of the way that IfaceUnfolding reflected a previous structure of unfoldings, not the current one. This MR refactors UnfoldingSource and IfaceUnfolding to be simpler and more consistent. It's largely just a refactor, but in UnfoldingSource (which moves to GHC.Types.Basic, since it is now used in IfaceSyn too), I distinguish between /user-specified/ and /system-generated/ stable unfoldings. data UnfoldingSource = VanillaSrc | StableUserSrc -- From a user-specified pragma | StableSystemSrc -- From a system-generated unfolding | CompulsorySrc This has a minor effect in CSE (see the use of isisStableUserUnfolding in GHC.Core.Opt.CSE), which I tripped over when working on specialisation, but it seems like a Good Thing to know anyway. - - - - - 7be6f9a4 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 INLINE/INLINEABLE pragmas in Foreign.Marshal.Array Foreign.Marshal.Array contains many small functions, all of which are overloaded, and which are critical for performance. Yet none of them had pragmas, so it was a fluke whether or not they got inlined. This patch makes them all either INLINE (small ones) or INLINEABLE and hence specialisable (larger ones). See Note [Specialising array operations] in that module. - - - - - b0c89dfa by Jade Lovelace at 2022-09-28T17:49:49-04:00 Export OnOff from GHC.Driver.Session I was working on fixing an issue where HLS was trying to pass its DynFlags to HLint, but didn't pass any of the disabled language extensions, which HLint would then assume are on because of their default values. Currently it's not possible to get any of the "No" flags because the `DynFlags.extensions` field can't really be used since it is [OnOff Extension] and OnOff is not exported. So let's export it. - - - - - 2f050687 by Bodigrim at 2022-09-28T17:50:28-04:00 Avoid Data.List.group; prefer Data.List.NonEmpty.group This allows to avoid further partiality, e. g., map head . group is replaced by map NE.head . NE.group, and there are less panic calls. - - - - - bc0020fa by M Farkas-Dyck at 2022-09-28T22:51:59-04:00 Clean up `findWiredInUnit`. In particular, avoid `head`. - - - - - 6a2eec98 by Bodigrim at 2022-09-28T22:52:38-04:00 Eliminate headFS, use unconsFS instead A small step towards #22185 to avoid partial functions + safe implementation of `startsWithUnderscore`. - - - - - 5a535172 by Sebastian Graf at 2022-09-29T17:04:20+02:00 Demand: Format Call SubDemands `Cn(sd)` as `C(n,sd)` (#22231) Justification in #22231. Short form: In a demand like `1C1(C1(L))` it was too easy to confuse which `1` belongs to which `C`. Now that should be more obvious. Fixes #22231 - - - - - ea0083bf by Bryan Richter at 2022-09-29T15:48:38-04:00 Revert "ci: enable parallel compression for xz" Combined wxth XZ_OPT=9, this blew the memory capacity of CI runners. This reverts commit a5f9c35f5831ef5108e87813a96eac62803852ab. - - - - - f5e8f493 by Sebastian Graf at 2022-09-30T18:42:13+02:00 Boxity: Don't update Boxity unless worker/wrapper follows (#21754) A small refactoring in our Core Opt pipeline and some new functions for transfering argument boxities from one signature to another to facilitate `Note [Don't change boxity without worker/wrapper]`. Fixes #21754. - - - - - 4baf7b1c by M Farkas-Dyck at 2022-09-30T17:45:47-04:00 Scrub various partiality involving empty lists. Avoids some uses of `head` and `tail`, and some panics when an argument is null. - - - - - 95ead839 by Alexis King at 2022-10-01T00:37:43-04:00 Fix a bug in continuation capture across multiple stack chunks - - - - - 22096652 by Bodigrim at 2022-10-01T00:38:22-04:00 Enforce internal invariant of OrdList and fix bugs in viewCons / viewSnoc `viewCons` used to ignore `Many` constructor completely, returning `VNothing`. `viewSnoc` violated internal invariant of `Many` being a non-empty list. - - - - - 48ab9ca5 by Nicolas Trangez at 2022-10-04T20:34:10-04:00 chore: extend `.editorconfig` for C files - - - - - b8df5c72 by Brandon Chinn at 2022-10-04T20:34:46-04:00 Fix docs for pattern synonyms - - - - - 463ffe02 by Oleg Grenrus at 2022-10-04T20:35:24-04:00 Use sameByteArray# in sameByteArray - - - - - fbe1e86e by Pierre Le Marre at 2022-10-05T15:58:43+02:00 Minor fixes following Unicode 15.0.0 update - Fix changelog for Unicode 15.0.0 - Fix the checksums of the downloaded Unicode files, in base's tool: "ucd2haskell". - - - - - 8a31d02e by Cheng Shao at 2022-10-05T20:40:41-04:00 rts: don't enforce aligned((8)) on 32-bit targets We simply need to align to the word size for pointer tagging to work. On 32-bit targets, aligned((8)) is wasteful. - - - - - 532de368 by Ryan Scott at 2022-10-06T07:45:46-04:00 Export symbolSing, SSymbol, and friends (CLC#85) This implements this Core Libraries Proposal: https://github.com/haskell/core-libraries-committee/issues/85 In particular, it: 1. Exposes the `symbolSing` method of `KnownSymbol`, 2. Exports the abstract `SSymbol` type used in `symbolSing`, and 3. Defines an API for interacting with `SSymbol`. This also makes corresponding changes for `natSing`/`KnownNat`/`SNat` and `charSing`/`KnownChar`/`SChar`. This fixes #15183 and addresses part (2) of #21568. - - - - - d83a92e6 by sheaf at 2022-10-07T07:36:30-04:00 Remove mention of make from README.md - - - - - 945e8e49 by Bodigrim at 2022-10-10T17:13:31-04:00 Add a newline before since pragma in Data.Array.Byte - - - - - 44fcdb04 by Vladislav Zavialov at 2022-10-10T17:14:06-04:00 Parser/PostProcess: rename failOp* functions There are three functions named failOp* in the parser: failOpNotEnabledImportQualifiedPost failOpImportQualifiedTwice failOpFewArgs Only the last one has anything to do with operators. The other two were named this way either by mistake or due to a misunderstanding of what "op" stands for. This small patch corrects this. - - - - - 96d32ff2 by Simon Peyton Jones at 2022-10-10T22:30:21+01:00 Make rewrite rules "win" over inlining If a rewrite rule and a rewrite rule compete in the simplifier, this patch makes sure that the rewrite rule "win". That is, in general a bit fragile, but it's a huge help when making specialisation work reliably, as #21851 and #22097 showed. The change is fairly straightforwad, and documented in Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration. Compile-times change, up and down a bit -- in some cases because we get better specialisation. But the payoff (more reliable specialisation) is large. Metrics: compile_time/bytes allocated ----------------------------------------------- T10421(normal) +3.7% BAD T10421a(normal) +5.5% T13253(normal) +1.3% T14052(ghci) +1.8% T15304(normal) -1.4% T16577(normal) +3.1% BAD T17516(normal) +2.3% T17836(normal) -1.9% T18223(normal) -1.8% T8095(normal) -1.3% T9961(normal) +2.5% BAD geo. mean +0.0% minimum -1.9% maximum +5.5% Nofib results are (bytes allocated) +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || +0.27% | | imaginary/rfib || -0.04% | | real/anna || +0.02% | | real/fem || -0.04% | | real/fluid || +1.68% | | real/gamteb || -0.34% | | real/gg || +1.54% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/infer || -0.03% | | real/prolog || +0.02% | | real/veritas || -0.47% | | shootout/fannkuch-redux || -0.03% | | shootout/k-nucleotide || -0.02% | | shootout/n-body || -0.06% | | shootout/spectral-norm || -0.01% | | spectral/cryptarithm2 || +1.25% | | spectral/fibheaps || +18.33% | | spectral/last-piece || -0.34% | +===============================++==========+ | geom mean || +0.17% | There are extensive notes in !8897 about the regressions. Briefly * fibheaps: there was a very delicately balanced inlining that tipped over the wrong way after this change. * cryptarithm2 and paraffins are caused by #22274, which is a separate issue really. (I.e. the right fix is *not* to make inlining "win" over rules.) So I'm accepting these changes Metric Increase: T10421 T16577 T9961 - - - - - ed4b5885 by Joachim Breitner at 2022-10-10T23:16:11-04:00 Utils.JSON: do not escapeJsonString in ToJson String instance as `escapeJsonString` is used in `renderJSON`, so the `JSString` constructor is meant to carry the unescaped string. - - - - - fbb88740 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Tidy implicit binds We want to put implicit binds into fat interface files, so the easiest thing to do seems to be to treat them uniformly with other binders. - - - - - e058b138 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Interface Files with Core Definitions This commit adds three new flags * -fwrite-if-simplified-core: Writes the whole core program into an interface file * -fbyte-code-and-object-code: Generate both byte code and object code when compiling a file * -fprefer-byte-code: Prefer to use byte-code if it's available when running TH splices. The goal for including the core bindings in an interface file is to be able to restart the compiler pipeline at the point just after simplification and before code generation. Once compilation is restarted then code can be created for the byte code backend. This can significantly speed up start-times for projects in GHCi. HLS already implements its own version of these extended interface files for this reason. Preferring to use byte-code means that we can avoid some potentially expensive code generation steps (see #21700) * Producing object code is much slower than producing bytecode, and normally you need to compile with `-dynamic-too` to produce code in the static and dynamic way, the dynamic way just for Template Haskell execution when using a dynamically linked compiler. * Linking many large object files, which happens once per splice, can be quite expensive compared to linking bytecode. And you can get GHC to compile the necessary byte code so `-fprefer-byte-code` has access to it by using `-fbyte-code-and-object-code`. Fixes #21067 - - - - - 9789ea8e by Matthew Pickering at 2022-10-11T12:48:45-04:00 Teach -fno-code about -fprefer-byte-code This patch teachs the code generation logic of -fno-code about -fprefer-byte-code, so that if we need to generate code for a module which prefers byte code, then we generate byte code rather than object code. We keep track separately which modules need object code and which byte code and then enable the relevant code generation for each. Typically the option will be enabled globally so one of these sets should be empty and we will just turn on byte code or object code generation. We also fix the bug where we would generate code for a module which enables Template Haskell despite the fact it was unecessary. Fixes #22016 - - - - - caced757 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Don't keep exit join points so much We were religiously keeping exit join points throughout, which had some bad effects (#21148, #22084). This MR does two things: * Arranges that exit join points are inhibited from inlining only in /one/ Simplifier pass (right after Exitification). See Note [Be selective about not-inlining exit join points] in GHC.Core.Opt.Exitify It's not a big deal, but it shaves 0.1% off compile times. * Inline used-once non-recursive join points very aggressively Given join j x = rhs in joinrec k y = ....j x.... where this is the only occurrence of `j`, we want to inline `j`. (Unless sm_keep_exits is on.) See Note [Inline used-once non-recursive join points] in GHC.Core.Opt.Simplify.Utils This is just a tidy-up really. It doesn't change allocation, but getting rid of a binding is always good. Very effect on nofib -- some up and down. - - - - - 284cf387 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Make SpecConstr bale out less often When doing performance debugging on #22084 / !8901, I found that the algorithm in SpecConstr.decreaseSpecCount was so aggressive that if there were /more/ specialisations available for an outer function, that could more or less kill off specialisation for an /inner/ function. (An example was in nofib/spectral/fibheaps.) This patch makes it a bit more aggressive, by dividing by 2, rather than by the number of outer specialisations. This makes the program bigger, temporarily: T19695(normal) ghc/alloc +11.3% BAD because we get more specialisation. But lots of other programs compile a bit faster and the geometric mean in perf/compiler is 0.0%. Metric Increase: T19695 - - - - - 66af1399 by Cheng Shao at 2022-10-11T12:49:59-04:00 CmmToC: emit explicit tail calls when the C compiler supports it Clang 13+ supports annotating a return statement using the musttail attribute, which guarantees that it lowers to a tail call if compilation succeeds. This patch takes advantage of that feature for the unregisterised code generator. The configure script tests availability of the musttail attribute, if it's available, the Cmm tail calls will become C tail calls that avoids the mini interpreter trampoline overhead. Nothing is affected if the musttail attribute is not supported. Clang documentation: https://clang.llvm.org/docs/AttributeReference.html#musttail - - - - - 7f0decd5 by Matthew Pickering at 2022-10-11T12:50:40-04:00 Don't include BufPos in interface files Ticket #22162 pointed out that the build directory was leaking into the ABI hash of a module because the BufPos depended on the location of the build tree. BufPos is only used in GHC.Parser.PostProcess.Haddock, and the information doesn't need to be propagated outside the context of a module. Fixes #22162 - - - - - dce9f320 by Cheng Shao at 2022-10-11T12:51:19-04:00 CLabel: fix isInfoTableLabel isInfoTableLabel does not take Cmm info table into account. This patch is required for data section layout of wasm32 NCG to work. - - - - - da679f2e by Bodigrim at 2022-10-11T18:02:59-04:00 Extend documentation for Data.List, mostly wrt infinite lists - - - - - 9c099387 by jwaldmann at 2022-10-11T18:02:59-04:00 Expand comment for Data.List.permutations - - - - - d3863cb7 by Bodigrim at 2022-10-11T18:03:37-04:00 ByteArray# is unlifted, not unboxed - - - - - f6260e8b by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Add missing declaration of stg_noDuplicate - - - - - 69ccec2c by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - f6e8feb4 by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - 866c736e by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Refactor IPE tracing support - - - - - 6b0d2022 by Ben Gamari at 2022-10-11T23:45:10-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - 9b572d54 by Ben Gamari at 2022-10-11T23:45:10-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 27978ceb by Krzysztof Gogolewski at 2022-10-11T23:45:46-04:00 Make Cmm Lint messages use dump style Lint errors indicate an internal error in GHC, so it makes sense to use it instead of the user style. This is consistent with Core Lint and STG Lint: https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Core/Lint.hs#L429 https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Stg/Lint.hs#L144 Fixes #22218. - - - - - 64a390d9 by Bryan Richter at 2022-10-12T09:52:51+03:00 Mark T7919 as fragile On x86_64-linux, T7919 timed out ~30 times during July 2022. And again ~30 times in September 2022. - - - - - 481467a5 by Ben Gamari at 2022-10-12T08:08:37-04:00 rts: Don't hint inlining of appendToRunQueue These hints have resulted in compile-time warnings due to failed inlinings for quite some time. Moreover, it's quite unlikely that inlining them is all that beneficial given that they are rather sizeable functions. Resolves #22280. - - - - - 81915089 by Curran McConnell at 2022-10-12T16:32:26-04:00 remove name shadowing - - - - - 626652f7 by Tamar Christina at 2022-10-12T16:33:13-04:00 winio: do not re-translate input when handle is uncooked - - - - - 5172789a by Charles Taylor at 2022-10-12T16:33:57-04:00 Unrestricted OverloadedLabels (#11671) Implements GHC proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst - - - - - ce293908 by Andreas Klebinger at 2022-10-13T05:58:19-04:00 Add a perf test for the generics code pattern from #21839. This code showed a strong shift between compile time (got worse) and run time (got a lot better) recently which is perfectly acceptable. However it wasn't clear why the compile time regression was happening initially so I'm adding this test to make it easier to track such changes in the future. - - - - - 78ab7afe by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 44692713 by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Add support for .fini sections - - - - - beebf546 by Simon Hengel at 2022-10-13T05:59:37-04:00 Update phases.rst (the name of the original source file is $1, not $2) - - - - - eda6c05e by Finley McIlwaine at 2022-10-13T06:00:17-04:00 Clearer error msg for newtype GADTs with defaulted kind When a newtype introduces GADT eq_specs due to a defaulted RuntimeRep, we detect this and print the error message with explicit kinds. This also refactors newtype type checking to use the new diagnostic infra. Fixes #21447 - - - - - 43ab435a by Pierre Le Marre at 2022-10-14T07:45:43-04:00 Add standard Unicode case predicates isUpperCase and isLowerCase. These predicates use the standard Unicode case properties and are more intuitive than isUpper and isLower. Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/90#issuecomment-1276649403. Fixes #14589 - - - - - aec5a443 by Bodigrim at 2022-10-14T07:46:21-04:00 Add type signatures in where-clause of Data.List.permutations The type of interleave' is very much revealing, otherwise it's extremely tough to decipher. - - - - - ee0deb80 by Ben Gamari at 2022-10-14T18:29:20-04:00 rts: Use pthread_setname_np correctly on Darwin As noted in #22206, pthread_setname_np on Darwin only supports setting the name of the calling thread. Consequently we must introduce a trampoline which first sets the thread name before entering the thread entrypoint. - - - - - 8eff62a4 by Ben Gamari at 2022-10-14T18:29:57-04:00 testsuite: Add test for #22282 This will complement mpickering's more general port of foundation's numerical testsuite, providing a test for the specific case found in #22282. - - - - - 62a55001 by Ben Gamari at 2022-10-14T18:29:57-04:00 ncg/aarch64: Fix sub-word sign extension yet again In adc7f108141a973b6dcb02a7836eed65d61230e8 we fixed a number of issues to do with sign extension in the AArch64 NCG found by ghc/test-primops>. However, this patch made a critical error, assuming that getSomeReg would allocate a fresh register for the result of its evaluation. However, this is not the case as `getSomeReg (CmmReg r) == r`. Consequently, any mutation of the register returned by `getSomeReg` may have unwanted side-effects on other expressions also mentioning `r`. In the fix listed above, this manifested as the registers containing the operands of binary arithmetic operations being incorrectly sign-extended. This resulted in #22282. Sadly, the rather simple structure of the tests generated by `test-primops` meant that this particular case was not exercised. Even more surprisingly, none of our testsuite caught this case. Here we fix this by ensuring that intermediate sign extension is performed in a fresh register. Fixes #22282. - - - - - 54e41b16 by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: ensure we are below maxHeapSize after returning megablocks When the heap is heavily block fragmented the live byte size might be low while the memory usage is high. We want to ensure that heap overflow triggers in these cases. We do so by checking that we can return enough megablocks to under maxHeapSize at the end of GC. - - - - - 29bb90db by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: trigger a major collection if megablock usage exceeds maxHeapSize When the heap is suffering from block fragmentation, live bytes might be low while megablock usage is high. If megablock usage exceeds maxHeapSize, we want to trigger a major GC to try to recover some memory otherwise we will die from a heapOverflow at the end of the GC. Fixes #21927 - - - - - 4a4641ca by Teo Camarasu at 2022-10-15T18:11:29+01:00 Add realease note for #21927 - - - - - c1e5719a by Sebastian Graf at 2022-10-17T11:58:46-04:00 DmdAnal: Look through unfoldings of DataCon wrappers (#22241) Previously, the demand signature we computed upfront for a DataCon wrapper lacked boxity information and was much less precise than the demand transformer for the DataCon worker. In this patch we adopt the solution to look through unfoldings of DataCon wrappers during Demand Analysis, but still attach a demand signature for other passes such as the Simplifier. See `Note [DmdAnal for DataCon wrappers]` for more details. Fixes #22241. - - - - - 8c72411d by Gergo ERDI at 2022-10-17T19:20:04-04:00 Add `Enum (Down a)` instance that swaps `succ` and `pred` See https://github.com/haskell/core-libraries-committee/issues/51 for discussion. The key points driving the implementation are the following two ideas: * For the `Int` type, `comparing (complement @Int)` behaves exactly as an order-swapping `compare @Int`. * `enumFrom @(Down a)` can be implemented in terms of `enumFromThen @a`, if only the corner case of starting at the very end is handled specially - - - - - d80ad2f4 by Alan Zimmerman at 2022-10-17T19:20:40-04:00 Update the check-exact infrastructure to match ghc-exactprint GHC tests the exact print annotations using the contents of utils/check-exact. The same functionality is provided via https://github.com/alanz/ghc-exactprint The latter was updated to ensure it works with all of the files on hackage when 9.2 was released, as well as updated to ensure users of the library could work properly (apply-refact, retrie, etc). This commit brings the changes from ghc-exactprint into GHC/utils/check-exact, adapting for the changes to master. Once it lands, it will form the basis for the 9.4 version of ghc-exactprint. See also discussion around this process at #21355 - - - - - 08ab5419 by Andreas Klebinger at 2022-10-17T19:21:15-04:00 Avoid allocating intermediate lists for non recursive bindings. We do so by having an explicit folding function that doesn't need to allocate intermediate lists first. Fixes #22196 - - - - - ff6275ef by Andreas Klebinger at 2022-10-17T19:21:52-04:00 Testsuite: Add a new tables_next_to_code predicate. And use it to avoid T21710a failing on non-tntc archs. Fixes #22169 - - - - - abb82f38 by Eric Lindblad at 2022-10-17T19:22:33-04:00 example rewrite - - - - - 39beb801 by Eric Lindblad at 2022-10-17T19:22:33-04:00 remove redirect - - - - - 0d9fb651 by Eric Lindblad at 2022-10-17T19:22:33-04:00 use heredoc - - - - - 0fa2d185 by Matthew Pickering at 2022-10-17T19:23:10-04:00 testsuite: Fix typo when setting llvm_ways Since 2014 llvm_ways has been set to [] so none of the tests which use only_ways(llvm_ways) have worked as expected. Hopefully the tests still pass with this typo fix! - - - - - ced664a2 by Krzysztof Gogolewski at 2022-10-17T19:23:10-04:00 Fix T15155l not getting -fllvm - - - - - 0ac60423 by Andreas Klebinger at 2022-10-18T03:34:47-04:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. Fixes #22042 and #21083 ------------------------- Metric Increase: T4801 Metric Decrease: T13035 ------------------------- - - - - - 9ecd1ac0 by M Farkas-Dyck at 2022-10-18T03:35:38-04:00 Make `Functor` a superclass of `TrieMap`, which lets us derive the `map` functions. - - - - - f60244d7 by Ben Gamari at 2022-10-18T03:36:15-04:00 configure: Bump minimum bootstrap GHC version Fixes #22245 - - - - - ba4bd4a4 by Matthew Pickering at 2022-10-18T03:36:55-04:00 Build System: Remove out-of-date comment about make build system Both make and hadrian interleave compilation of modules of different modules and don't respect the package boundaries. Therefore I just remove this comment which points out this "difference". Fixes #22253 - - - - - e1bbd368 by Matthew Pickering at 2022-10-18T16:15:49+02:00 Allow configuration of error message printing This MR implements the idea of #21731 that the printing of a diagnostic method should be configurable at the printing time. The interface of the `Diagnostic` class is modified from: ``` class Diagnostic a where diagnosticMessage :: a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` to ``` class Diagnostic a where type DiagnosticOpts a defaultDiagnosticOpts :: DiagnosticOpts a diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` and so each `Diagnostic` can implement their own configuration record which can then be supplied by a client in order to dictate how to print out the error message. At the moment this only allows us to implement #21722 nicely but in future it is more natural to separate the configuration of how much information we put into an error message and how much we decide to print out of it. Updates Haddock submodule - - - - - 99dc3e3d by Matthew Pickering at 2022-10-18T16:15:53+02:00 Add -fsuppress-error-contexts to disable printing error contexts in errors In many development environments, the source span is the primary means of seeing what an error message relates to, and the In the expression: and In an equation for: clauses are not particularly relevant. However, they can grow to be quite long, which can make the message itself both feel overwhelming and interact badly with limited-space areas. It's simple to implement this flag so we might as well do it and give the user control about how they see their messages. Fixes #21722 - - - - - 5b3a992f by Dai at 2022-10-19T10:45:45-04:00 Add VecSlot for unboxed sums of SIMD vectors This patch adds the missing `VecRep` case to `primRepSlot` function and all the necessary machinery to carry this new `VecSlot` through code generation. This allows programs involving unboxed sums of SIMD vectors to be written and compiled. Fixes #22187 - - - - - 6d7d9181 by sheaf at 2022-10-19T10:45:45-04:00 Remove SIMD conversions This patch makes it so that packing/unpacking SIMD vectors always uses the right sized types, e.g. unpacking a Word16X4# will give a tuple of Word16#s. As a result, we can get rid of the conversion instructions that were previously required. Fixes #22296 - - - - - 3be48877 by sheaf at 2022-10-19T10:45:45-04:00 Cmm Lint: relax SIMD register assignment check As noted in #22297, SIMD vector registers can be used to store different kinds of values, e.g. xmm1 can be used both to store integer and floating point values. The Cmm type system doesn't properly account for this, so we weaken the Cmm register assignment lint check to only compare widths when comparing a vector type with its allocated vector register. - - - - - f7b7a312 by sheaf at 2022-10-19T10:45:45-04:00 Disable some SIMD tests on non-X86 architectures - - - - - 83638dce by M Farkas-Dyck at 2022-10-19T10:46:29-04:00 Scrub various partiality involving lists (again). Lets us avoid some use of `head` and `tail`, and some panics. - - - - - c3732c62 by M Farkas-Dyck at 2022-10-19T10:47:13-04:00 Enforce invariant of `ListBag` constructor. - - - - - 488d3631 by Bodigrim at 2022-10-19T10:47:52-04:00 More precise types for fields of OverlappingInstances and UnsafeOverlap in TcSolverReportMsg It's clear from asserts in `GHC.Tc.Errors` that `overlappingInstances_matches` and `unsafeOverlapped` are supposed to be non-empty, and `unsafeOverlap_matches` contains a single instance, but these invariants are immediately lost afterwards and not encoded in types. This patch enforces the invariants by pattern matching and makes types more precise, avoiding asserts and partial functions such as `head`. - - - - - 607ce263 by sheaf at 2022-10-19T10:47:52-04:00 Rename unsafeOverlap_matches -> unsafeOverlap_match in UnsafeOverlap - - - - - 1fab9598 by Matthew Pickering at 2022-10-19T10:48:29-04:00 Add SpliceTypes test for hie files This test checks that typed splices and quotes get the right type information when used in hiefiles. See #21619 - - - - - a8b52786 by Jan Hrček at 2022-10-19T10:49:09-04:00 Small language fixes in 'Using GHC' - - - - - 1dab1167 by Gergő Érdi at 2022-10-19T10:49:51-04:00 Fix typo in `Opt_WriteIfSimplifiedCore`'s name - - - - - b17cfc9c by sheaf at 2022-10-19T10:50:37-04:00 TyEq:N assertion: only for saturated applications The assertion that checked TyEq:N in canEqCanLHSFinish incorrectly triggered in the case of an unsaturated newtype TyCon heading the RHS, even though we can't unwrap such an application. Now, we only trigger an assertion failure in case of a saturated application of a newtype TyCon. Fixes #22310 - - - - - ff6f2228 by M Farkas-Dyck at 2022-10-20T16:15:51-04:00 CoreToStg: purge `DynFlags`. - - - - - 1ebd521f by Matthew Pickering at 2022-10-20T16:16:27-04:00 ci: Make fat014 test robust For some reason I implemented this as a makefile test rather than a ghci_script test. Hopefully making it a ghci_script test makes it more robust. Fixes #22313 - - - - - 8cd6f435 by Curran McConnell at 2022-10-21T02:58:01-04:00 remove a no-warn directive from GHC.Cmm.ContFlowOpt This patch is motivated by the desire to remove the {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} directive at the top of GHC.Cmm.ContFlowOpt. (Based on the text in this coding standards doc, I understand it's a goal of the project to remove such directives.) I chose this task because I'm a new contributor to GHC, and it seemed like a good way to get acquainted with the patching process. In order to address the warning that arose when I removed the no-warn directive, I added a case to removeUnreachableBlocksProc to handle the CmmData constructor. Clearly, since this partial function has not been erroring out in the wild, its inputs are always in practice wrapped by the CmmProc constructor. Therefore the CmmData case is handled by a precise panic (which is an improvement over the partial pattern match from before). - - - - - a2af7c4c by Nicolas Trangez at 2022-10-21T02:58:39-04:00 build: get rid of `HAVE_TIME_H` As advertized by `autoreconf`: > All current systems provide time.h; it need not be checked for. Hence, remove the check for it in `configure.ac` and remove conditional inclusion of the header in `HAVE_TIME_H` blocks where applicable. The `time.h` header was being included in various source files without a `HAVE_TIME_H` guard already anyway. - - - - - 25cdc630 by Nicolas Trangez at 2022-10-21T02:58:39-04:00 rts: remove use of `TIME_WITH_SYS_TIME` `autoreconf` will insert an `m4_warning` when the obsolescent `AC_HEADER_TIME` macro is used: > Update your code to rely only on HAVE_SYS_TIME_H, > then remove this warning and the obsolete code below it. > All current systems provide time.h; it need not be checked for. > Not all systems provide sys/time.h, but those that do, all allow > you to include it and time.h simultaneously. Presence of `sys/time.h` was already checked in an earlier `AC_CHECK_HEADERS` invocation, so `AC_HEADER_TIME` can be dropped and guards relying on `TIME_WITH_SYS_TIME` can be reworked to (unconditionally) include `time.h` and include `sys/time.h` based on `HAVE_SYS_TIME_H`. Note the documentation of `AC_HEADER_TIME` in (at least) Autoconf 2.67 says > This macro is obsolescent, as current systems can include both files > when they exist. New programs need not use this macro. - - - - - 1fe7921c by Eric Lindblad at 2022-10-21T02:59:21-04:00 runhaskell - - - - - e3b3986e by David Feuer at 2022-10-21T03:00:00-04:00 Document how to quote certain names with spaces Quoting a name for Template Haskell is a bit tricky if the second character of that name is a single quote. The User's Guide falsely claimed that it was impossible. Document how to do it. Fixes #22236 - - - - - 0eba81e8 by Krzysztof Gogolewski at 2022-10-21T03:00:00-04:00 Fix syntax - - - - - a4dbd102 by Ben Gamari at 2022-10-21T09:11:12-04:00 Fix manifest filename when writing Windows .rc files As noted in #12971, we previously used `show` which resulted in inappropriate escaping of non-ASCII characters. - - - - - 30f0d9a9 by Ben Gamari at 2022-10-21T09:11:12-04:00 Write response files in UTF-8 on Windows This reverts the workaround introduced in f63c8ef33ec9666688163abe4ccf2d6c0428a7e7, which taught our response file logic to write response files with the `latin1` encoding to workaround `gcc`'s lacking Unicode support. This is now no longer necessary (and in fact actively unhelpful) since we rather use Clang. - - - - - b8304648 by M Farkas-Dyck at 2022-10-21T09:11:56-04:00 Scrub some partiality in `GHC.Core.Opt.Simplify.Utils`. - - - - - 09ec7de2 by Teo Camarasu at 2022-10-21T13:23:07-04:00 template-haskell: Improve documentation of strictness annotation types Before it was undocumentated that DecidedLazy can be returned by reifyConStrictness for strict fields. This can happen when a field has an unlifted type or its the single field of a newtype constructor. Fixes #21380 - - - - - 88172069 by M Farkas-Dyck at 2022-10-21T13:23:51-04:00 Delete `eqExpr`, since GHC 9.4 has been released. - - - - - 86e6549e by Ömer Sinan Ağacan at 2022-10-22T07:41:30-04:00 Introduce a standard thunk for allocating strings Currently for a top-level closure in the form hey = unpackCString# x we generate code like this: Main.hey_entry() // [R1] { info_tbls: [(c2T4, label: Main.hey_info rep: HeapRep static { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset c2T4: // global _rqm::P64 = R1; if ((Sp + 8) - 24 < SpLim) (likely: False) goto c2T5; else goto c2T6; c2T5: // global R1 = _rqm::P64; call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8; c2T6: // global (_c2T1::I64) = call "ccall" arg hints: [PtrHint, PtrHint] result hints: [PtrHint] newCAF(BaseReg, _rqm::P64); if (_c2T1::I64 == 0) goto c2T3; else goto c2T2; c2T3: // global call (I64[_rqm::P64])() args: 8, res: 0, upd: 8; c2T2: // global I64[Sp - 16] = stg_bh_upd_frame_info; I64[Sp - 8] = _c2T1::I64; R2 = hey1_r2Gg_bytes; Sp = Sp - 16; call GHC.CString.unpackCString#_info(R2) args: 24, res: 0, upd: 24; } } This code is generated for every string literal. Only difference between top-level closures like this is the argument for the bytes of the string (hey1_r2Gg_bytes in the code above). With this patch we introduce a standard thunk in the RTS, called stg_MK_STRING_info, that does what `unpackCString# x` does, except it gets the bytes address from the payload. Using this, for the closure above, we generate this: Main.hey_closure" { Main.hey_closure: const stg_MK_STRING_info; const 0; // padding for indirectee const 0; // static link const 0; // saved info const hey1_r1Gg_bytes; // the payload } This is much smaller in code. Metric Decrease: T10421 T11195 T12150 T12425 T16577 T18282 T18698a T18698b Co-Authored By: Ben Gamari <ben at well-typed.com> - - - - - 1937016b by Andreas Klebinger at 2022-10-22T07:42:06-04:00 hadrian: Improve error for wrong key/value errors. - - - - - 11fe42d8 by Vladislav Zavialov at 2022-10-23T00:11:50+03:00 Class layout info (#19623) Updates the haddock submodule. - - - - - f0a90c11 by Sven Tennie at 2022-10-24T00:12:51-04:00 Pin used way for test cloneMyStack (#21977) cloneMyStack checks the order of closures on the cloned stack. This may change for different ways. Thus we limit this test to one way (normal). - - - - - 0614e74d by Aaron Allen at 2022-10-24T17:11:21+02:00 Convert Diagnostics in GHC.Tc.Gen.Splice (#20116) Replaces uses of `TcRnUnknownMessage` in `GHC.Tc.Gen.Splice` with structured diagnostics. closes #20116 - - - - - 8d2dbe2d by Andreas Klebinger at 2022-10-24T15:59:41-04:00 Improve stg lint for unboxed sums. It now properly lints cases where sums end up distributed over multiple args after unarise. Fixes #22026. - - - - - 41406da5 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Fix binder-swap bug This patch fixes #21229 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. Test is already in simplCore/should_run/T21229 This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. (This is done in a separate patch.) I also modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs In Simplify.Iteration.addAltUnfoldings I also eliminated a guard Many <- idMult case_bndr because we concluded, in #22123, that it was doing no good. - - - - - 5a997e16 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Make the specialiser handle polymorphic specialisation Ticket #13873 unexpectedly showed that a SPECIALISE pragma made a program run (a lot) slower, because less specialisation took place overall. It turned out that the specialiser was missing opportunities because of quantified type variables. It was quite easy to fix. The story is given in Note [Specialising polymorphic dictionaries] Two other minor fixes in the specialiser * There is no benefit in specialising data constructor /wrappers/. (They can appear overloaded because they are given a dictionary to store in the constructor.) Small guard in canSpecImport. * There was a buglet in the UnspecArg case of specHeader, in the case where there is a dead binder. We need a LitRubbish filler for the specUnfolding stuff. I expanded Note [Drop dead args from specialisations] to explain. There is a 4% increase in compile time for T15164, because we generate more specialised code. This seems OK. Metric Increase: T15164 - - - - - 7f203d00 by Sylvain Henry at 2022-10-25T18:07:43-04:00 Numeric exceptions: replace FFI calls with primops ghc-bignum needs a way to raise numerical exceptions defined in base package. At the time we used FFI calls into primops defined in the RTS. These FFI calls had to be wrapped into hacky bottoming functions because "foreign import prim" syntax doesn't support giving a bottoming demand to the foreign call (cf #16929). These hacky wrapper functions trip up the JavaScript backend (#21078) because they are polymorphic in their return type. This commit replaces them with primops very similar to raise# but raising predefined exceptions. - - - - - 0988a23d by Sylvain Henry at 2022-10-25T18:08:24-04:00 Enable popcount rewrite rule when cross-compiling The comment applies only when host's word size < target's word size. So we can relax the guard. - - - - - a2f53ac8 by Sylvain Henry at 2022-10-25T18:09:05-04:00 Add GHC.SysTools.Cpp module Move doCpp out of the driver to be able to use it in the upcoming JS backend. - - - - - 1fd7f201 by Ben Gamari at 2022-10-25T18:09:42-04:00 llvm-targets: Add datalayouts for big-endian AArch64 targets Fixes #22311. Thanks to @zeldin for the patch. - - - - - f5a486eb by Krzysztof Gogolewski at 2022-10-25T18:10:19-04:00 Cleanup String/FastString conversions Remove unused mkPtrString and isUnderscoreFS. We no longer use mkPtrString since 1d03d8bef96. Remove unnecessary conversions between FastString and String and back. - - - - - f7bfb40c by Ryan Scott at 2022-10-26T00:01:24-04:00 Broaden the in-scope sets for liftEnvSubst and composeTCvSubst This patch fixes two distinct (but closely related) buglets that were uncovered in #22235: * `liftEnvSubst` used an empty in-scope set, which was not wide enough to cover the variables in the range of the substitution. This patch fixes this by populating the in-scope set from the free variables in the range of the substitution. * `composeTCvSubst` applied the first substitution argument to the range of the second substitution argument, but the first substitution's in-scope set was not wide enough to cover the range of the second substutition. We similarly fix this issue in this patch by widening the first substitution's in-scope set before applying it. Fixes #22235. - - - - - 0270cc54 by Vladislav Zavialov at 2022-10-26T00:02:01-04:00 Introduce TcRnWithHsDocContext (#22346) Before this patch, GHC used withHsDocContext to attach an HsDocContext to an error message: addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg) The problem with this approach is that it only works with TcRnUnknownMessage. But could we attach an HsDocContext to a structured error message in a generic way? This patch solves the problem by introducing a new constructor to TcRnMessage: data TcRnMessage where ... TcRnWithHsDocContext :: !HsDocContext -> !TcRnMessage -> TcRnMessage ... - - - - - 9ab31f42 by Sylvain Henry at 2022-10-26T09:32:20+02:00 Testsuite: more precise test options Necessary for newer cross-compiling backends (JS, Wasm) that don't support TH yet. - - - - - f60a1a62 by Vladislav Zavialov at 2022-10-26T12:17:14-04:00 Use TcRnVDQInTermType in noNestedForallsContextsErr (#20115) When faced with VDQ in the type of a term, GHC generates the following error message: Illegal visible, dependent quantification in the type of a term (GHC does not yet support this) Prior to this patch, there were two ways this message could have been generated and represented: 1. with the dedicated constructor TcRnVDQInTermType (see check_type in GHC.Tc.Validity) 2. with the transitional constructor TcRnUnknownMessage (see noNestedForallsContextsErr in GHC.Rename.Utils) Not only this led to duplication of code generating the final SDoc, it also made it tricky to track the origin of the error message. This patch fixes the problem by using TcRnVDQInTermType exclusively. - - - - - 223e159d by Owen Shepherd at 2022-10-27T13:54:33-04:00 Remove source location information from interface files This change aims to minimize source location information leaking into interface files, which makes ABI hashes dependent on the build location. The `Binary (Located a)` instance has been removed completely. It seems that the HIE interface still needs the ability to serialize SrcSpans, but by wrapping the instances, it should be a lot more difficult to inadvertently add source location information. - - - - - 22e3deb9 by Simon Peyton Jones at 2022-10-27T13:55:37-04:00 Add missing dict binds to specialiser I had forgotten to add the auxiliary dict bindings to the /unfolding/ of a specialised function. This caused #22358, which reports failures when compiling Hackage packages fixed-vector indexed-traversable Regression test T22357 is snarfed from indexed-traversable - - - - - a8ed36f9 by Evan Relf at 2022-10-27T13:56:36-04:00 Fix broken link to `async` package - - - - - 750846cd by Zubin Duggal at 2022-10-28T00:49:22-04:00 Pass correct package db when testing stage1. It used to pick the db for stage-2 which obviously didn't work. - - - - - ad612f55 by Krzysztof Gogolewski at 2022-10-28T00:50:00-04:00 Minor SDoc-related cleanup * Rename pprCLabel to pprCLabelStyle, and use the name pprCLabel for a function using CStyle (analogous to pprAsmLabel) * Move LabelStyle to the CLabel module, it no longer needs to be in Outputable. * Move calls to 'text' right next to literals, to make sure the text/str rule is triggered. * Remove FastString/String roundtrip in Tc.Deriv.Generate * Introduce showSDocForUser', which abstracts over a pattern in GHCi.UI - - - - - c2872f3f by Bryan Richter at 2022-10-28T11:36:34+03:00 CI: Don't run lint-submods on nightly Fixes #22325 - - - - - 270037fa by Hécate Moonlight at 2022-10-28T19:46:12-04:00 Start the deprecation process for GHC.Pack - - - - - d45d8cb3 by M Farkas-Dyck at 2022-11-01T12:47:21-04:00 Drop a kludge for binutils<2.17, which is now over 10 years old. - - - - - 8ee8b418 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: `name` argument of `createOSThread` can be `const` Since we don't intend to ever change the incoming string, declare this to be true. Also, in the POSIX implementation, the argument is no longer `STG_UNUSED` (since ee0deb8054da2a597fc5624469b4c44fd769ada2) in any code path. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 - - - - - 13b5f102 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix lifetime of `start_thread`s `name` value Since, unlike the code in ee0deb8054da2^, usage of the `name` value passed to `createOSThread` now outlives said function's lifetime, and could hence be released by the caller by the time the new thread runs `start_thread`, it needs to be copied. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - edd175c9 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix OS thread naming in ticker Since ee0deb805, the use of `pthread_setname_np` on Darwin was fixed when invoking `createOSThread`. However, the 'ticker' has some thread-creation code which doesn't rely on `createOSThread`, yet also uses `pthread_setname_np`. This patch enforces all thread creation to go through a single function, which uses the (correct) thread-naming code introduced in ee0deb805. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22206 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - b7a00113 by Krzysztof Gogolewski at 2022-11-01T12:48:35-04:00 Typo: rename -fwrite-if-simplfied-core to -fwrite-if-simplified-core - - - - - 30e625e6 by Vladislav Zavialov at 2022-11-01T12:49:10-04:00 ThToHs: fix overzealous parenthesization Before this patch, when converting from TH.Exp to LHsExpr GhcPs, the compiler inserted more parentheses than required: ((f a) (b + c)) d This was happening because the LHS of the function application was parenthesized as if it was the RHS. Now we use funPrec and appPrec appropriately and produce sensibly parenthesized expressions: f a (b + c) d I also took the opportunity to remove the special case for LamE, which was not special at all and simply duplicated code. - - - - - 0560821f by Simon Peyton Jones at 2022-11-01T12:49:47-04:00 Add accurate skolem info when quantifying Ticket #22379 revealed that skolemiseQuantifiedTyVar was dropping the passed-in skol_info on the floor when it encountered a SkolemTv. Bad! Several TyCons thereby share a single SkolemInfo on their binders, which lead to bogus error reports. - - - - - 38d19668 by Fendor at 2022-11-01T12:50:25-04:00 Expose UnitEnvGraphKey for user-code - - - - - 77e24902 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Shrink test case for #22357 Ryan Scott offered a cut-down repro case (60 lines instead of more than 700 lines) - - - - - 4521f649 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Add two tests for #17366 - - - - - 6b400d26 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_NORETURN` Instead of sprinkling the codebase with `GNU(C3)_ATTRIBUTE(__noreturn__)`, add a `STG_NORETURN` macro (for, basically, the same thing) similar to `STG_UNUSED` and others, and update the code to use this macro where applicable. - - - - - f9638654 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: consistently use `STG_UNUSED` - - - - - 81a58433 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_USED` Similar to `STG_UNUSED`, have a specific macro for `__attribute__(used)`. - - - - - 41e1f748 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_MALLOC` Instead of using `GNUC3_ATTRIBUTE(__malloc__)`, provide a `STG_MALLOC` macro definition and use it instead. - - - - - 3a9a8bde by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `STG_UNUSED` - - - - - 9ab999de by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: specify deallocator of allocating functions This patch adds a new `STG_MALLOC1` macro (and its counterpart `STG_MALLOC2` for completeness) which allows to specify the deallocation function to be used with allocations of allocating functions, and applies it to `stg*allocBytes`. It also fixes a case where `free` was used to free up an `stgMallocBytes` allocation, found by the above change. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-malloc-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 81c0c7c9 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `alloc_size` attribute This patch adds the `STG_ALLOC_SIZE1` and `STG_ALLOC_SIZE2` macros which allow to set the `alloc_size` attribute on functions, when available. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-alloc_005fsize-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 99a1d896 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: add and use `STG_RETURNS_NONNULL` See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-returns_005fnonnull-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - c235b399 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: tag `stgStrndup` as `STG_MALLOC` See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - ed81b448 by Oleg Grenrus at 2022-11-02T12:07:27-04:00 Move Symbol implementation note out of public haddock - - - - - 284fd39c by Ben Gamari at 2022-11-03T01:58:54-04:00 gen-dll: Drop it Currently it is only used by the make build system, which is soon to be retired, and it has not built since 41cf758b. We may need to reintroduce it when dynamic-linking support is introduced on Windows, but we will cross that bridge once we get there. Fixes #21753. - - - - - 24f4f54f by Matthew Pickering at 2022-11-03T01:59:30-04:00 Port foundation numeric tests to GHC testsuite This commit ports the numeric tests which found a regression in GHC-9.4. https://github.com/haskell-foundation/foundation/issues/571 Included in the commit is a simple random number generator and simplified QuickCheck implementation. In future these could be factored out of this standalone file and reused as a general purpose library which could be used for other QuickCheck style tests in the testsuite. See #22282 - - - - - d51bf7bd by M Farkas-Dyck at 2022-11-03T02:00:13-04:00 git: ignore HIE files. Cleans up git status if one sets -fwrite-ide-info in hadrian/ghci. - - - - - a9fc15b1 by Matthew Pickering at 2022-11-03T02:00:49-04:00 Clarify status of bindings in WholeCoreBindings Gergo points out that these bindings are tidied, rather than prepd as the variable claims. Therefore we update the name of the variable to reflect reality and add a comment to the data type to try to erase any future confusion. Fixes #22307 - - - - - 634da448 by Bodigrim at 2022-11-03T21:25:02+00:00 Fix haddocks for GHC.IORef - - - - - 31125154 by Andreas Klebinger at 2022-11-03T23:08:09-04:00 Export pprTrace and friends from GHC.Prelude. Introduces GHC.Prelude.Basic which can be used in modules which are a dependency of the ppr code. - - - - - bdc8cbb3 by Bryan Richter at 2022-11-04T10:27:37+02:00 CI: Allow hadrian-ghc-in-ghci to run in nightlies Since lint-submods doesn't run in nightlies, hadrian-ghc-in-ghci needs to mark it as "optional" so it can run if the job doesn't exist. Fixes #22396. - - - - - 3c0e3793 by Krzysztof Gogolewski at 2022-11-05T00:29:57-04:00 Minor refactor around FastStrings Pass FastStrings to functions directly, to make sure the rule for fsLit "literal" fires. Remove SDoc indirection in GHCi.UI.Tags and GHC.Unit.Module.Graph. - - - - - e41b2f55 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump unix submodule to 2.8.0.0 Also bumps process and ghc-boot bounds on unix. For hadrian, when cross-compiling, we add -Wwarn=unused-imports -Wwarn=unused-top-binds to validation flavour. Further fixes in unix and/or hsc2hs is needed to make it completely free of warnings; for the time being, this change is needed to unblock other cross-compilation related work. - - - - - 42938a58 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump Win32 submodule to 2.13.4.0 Fixes #22098 - - - - - e7372bc5 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump ci-images revision ci-images has recently been updated, including changes needed for wasm32-wasi CI. - - - - - 88cb9492 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump gmp-tarballs submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 69427ce9 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump haskeline submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 5fe11fe6 by Carter Schonwald at 2022-11-07T13:22:14-05:00 bump llvm upper bound - - - - - 68f49874 by M Farkas-Dyck at 2022-11-08T12:53:55-05:00 Define `Infinite` list and use where appropriate. Also add perf test for infinite list fusion. In particular, in `GHC.Core`, often we deal with infinite lists of roles. Also in a few locations we deal with infinite lists of names. Thanks to simonpj for helping to write the Note [Fusion for `Infinite` lists]. - - - - - ce726cd2 by Ross Paterson at 2022-11-08T12:54:34-05:00 Fix TypeData issues (fixes #22315 and #22332) There were two bugs here: 1. Treating type-level constructors as PromotedDataCon doesn't always work, in particular because constructors promoted via DataKinds are called both T and 'T. (Tests T22332a, T22332b, T22315a, T22315b) Fix: guard these cases with isDataKindsPromotedDataCon. 2. Type-level constructors were sent to the code generator, producing things like constructor wrappers. (Tests T22332a, T22332b) Fix: test for them in isDataTyCon. Other changes: * changed the marking of "type data" DataCon's as suggested by SPJ. * added a test TDGADT for a type-level GADT. * comment tweaks * change tcIfaceTyCon to ignore IfaceTyConInfo, so that IfaceTyConInfo is used only for pretty printing, not for typechecking. (SPJ) - - - - - 132f8908 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Clarify msum/asum documentation - - - - - bb5888c5 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Add example for (<$) - - - - - 080fffa1 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Document what Alternative/MonadPlus instances actually do - - - - - 92ccb8de by Giles Anderson at 2022-11-09T09:27:52-05:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Instance (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnWarnUnsatisfiedMinimalDefinition TcRnMisplacedInstSig TcRnBadBootFamInstDeclErr TcRnIllegalFamilyInstance TcRnAssocInClassErr TcRnBadFamInstDecl TcRnNotOpenFamily - - - - - 90c5abd4 by Hécate Moonlight at 2022-11-09T09:28:30-05:00 GHCi tags generation phase 2 see #19884 - - - - - f9f17b68 by Simon Peyton Jones at 2022-11-10T12:20:03+00:00 Fire RULES in the Specialiser The Specialiser has, for some time, fires class-op RULES in the specialiser itself: see Note [Specialisation modulo dictionary selectors] This MR beefs it up a bit, so that it fires /all/ RULES in the specialiser, not just class-op rules. See Note [Fire rules in the specialiser] The result is a bit more specialisation; see test simplCore/should_compile/T21851_2 This pushed me into a bit of refactoring. I made a new data types GHC.Core.Rules.RuleEnv, which combines - the several source of rules (local, home-package, external) - the orphan-module dependencies in a single record for `getRules` to consult. That drove a bunch of follow-on refactoring, including allowing me to remove cr_visible_orphan_mods from the CoreReader data type. I moved some of the RuleBase/RuleEnv stuff into GHC.Core.Rule. The reorganisation in the Simplifier improve compile times a bit (geom mean -0.1%), but T9961 is an outlier Metric Decrease: T9961 - - - - - 2b3d0bee by Simon Peyton Jones at 2022-11-10T12:21:13+00:00 Make indexError work better The problem here is described at some length in Note [Boxity for bottoming functions] and Note [Reboxed crud for bottoming calls] in GHC.Core.Opt.DmdAnal. This patch adds a SPECIALISE pragma for indexError, which makes it much less vulnerable to the problem described in these Notes. (This came up in another line of work, where a small change made indexError do reboxing (in nofib/spectral/simple/table_sort) that didn't happen before my change. I've opened #22404 to document the fagility. - - - - - 399e921b by Simon Peyton Jones at 2022-11-10T12:21:14+00:00 Fix DsUselessSpecialiseForClassMethodSelector msg The error message for DsUselessSpecialiseForClassMethodSelector was just wrong (a typo in some earlier work); trivial fix - - - - - dac0682a by Sebastian Graf at 2022-11-10T21:16:01-05:00 WorkWrap: Unboxing unboxed tuples is not always useful (#22388) See Note [Unboxing through unboxed tuples]. Fixes #22388. - - - - - 1230c268 by Sebastian Graf at 2022-11-10T21:16:01-05:00 Boxity: Handle argument budget of unboxed tuples correctly (#21737) Now Budget roughly tracks the combined width of all arguments after unarisation. See the changes to `Note [Worker argument budgets]`. Fixes #21737. - - - - - 2829fd92 by Cheng Shao at 2022-11-11T00:26:54-05:00 autoconf: check getpid getuid raise This patch adds checks for getpid, getuid and raise in autoconf. These functions are absent in wasm32-wasi and thus needs to be checked. - - - - - f5dfd1b4 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add -Wwarn only for cross-compiling unix - - - - - 2e6ab453 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add targetSupportsThreadedRts flag This patch adds a targetSupportsThreadedRts flag to indicate whether the target supports the threaded rts at all, different from existing targetSupportsSMP that checks whether -N is supported by the RTS. All existing flavours have also been updated accordingly to respect this flags. Some targets (e.g. wasm32-wasi) does not support the threaded rts, therefore this flag is needed for the default flavours to work. It makes more sense to have proper autoconf logic to check for threading support, but for the time being, we just set the flag to False iff the target is wasm32. - - - - - 8104f6f5 by Cheng Shao at 2022-11-11T00:26:55-05:00 Fix Cmm symbol kind - - - - - b2035823 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add the two key graph modules from Martin Erwig's FGL Martin Erwig's FGL (Functional Graph Library) provides an "inductive" representation of graphs. A general graph has labeled nodes and labeled edges. The key operation on a graph is to decompose it by removing one node, together with the edges that connect the node to the rest of the graph. There is also an inverse composition operation. The decomposition and composition operations make this representation of graphs exceptionally well suited to implement graph algorithms in which the graph is continually changing, as alluded to in #21259. This commit adds `GHC.Data.Graph.Inductive.Graph`, which defines the interface, and `GHC.Data.Graph.Inductive.PatriciaTree`, which provides an implementation. Both modules are taken from `fgl-5.7.0.3` on Hackage, with these changes: - Copyright and license text have been copied into the files themselves, not stored separately. - Some calls to `error` have been replaced with calls to `panic`. - Conditional-compilation support for older versions of GHC, `containers`, and `base` has been removed. - - - - - 3633a5f5 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add new modules for reducibility and WebAssembly translation - - - - - df7bfef8 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add support for the wasm32-wasi target tuple This patch adds the wasm32-wasi tuple support to various places in the tree: autoconf, hadrian, ghc-boot and also the compiler. The codegen logic will come in subsequent commits. - - - - - 32ae62e6 by Cheng Shao at 2022-11-11T00:26:55-05:00 deriveConstants: parse .ll output for wasm32 due to broken nm This patch makes deriveConstants emit and parse an .ll file when targeting wasm. It's a necessary workaround for broken llvm-nm on wasm, which isn't capable of reporting correct constant values when parsing an object. - - - - - 07e92c92 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: workaround cmm's improper variadic ccall breaking wasm32 typechecking Unlike other targets, wasm requires the function signature of the call site and callee to strictly match. So in Cmm, when we call a C function that actually returns a value, we need to add an _unused local variable to receive it, otherwise type error awaits. An even bigger problem is calling variadic functions like barf() and such. Cmm doesn't support CAPI calling convention yet, so calls to variadic functions just happen to work in some cases with some target's ABI. But again, it doesn't work with wasm. Fortunately, the wasm C ABI lowers varargs to a stack pointer argument, and it can be passed NULL when no other arguments are expected to be passed. So we also add the additional unused NULL arguments to those functions, so to fix wasm, while not affecting behavior on other targets. - - - - - 00124d12 by Cheng Shao at 2022-11-11T00:26:55-05:00 testsuite: correct sleep() signature in T5611 In libc, sleep() returns an integer. The ccall type signature should match the libc definition, otherwise it causes linker error on wasm. - - - - - d72466a9 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: prefer ffi_type_void over FFI_TYPE_VOID This patch uses ffi_type_void instead of FFI_TYPE_VOID in the interpreter code, since the FFI_TYPE_* macros are not available in libffi-wasm32 yet. The libffi public documentation also only mentions the lower-case ffi_type_* symbols, so we should prefer the lower-case API here. - - - - - 4d36a1d3 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't define RTS_USER_SIGNALS when signal.h is not present In the rts, we have a RTS_USER_SIGNALS macro, and most signal-related logic is guarded with RTS_USER_SIGNALS. This patch extends the range of code guarded with RTS_USER_SIGNALS, and define RTS_USER_SIGNALS iff signal.h is actually detected by autoconf. This is required for wasm32-wasi to work, which lacks signals. - - - - - 3f1e164f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: use HAVE_GETPID to guard subprocess related logic We've previously added detection of getpid() in autoconf. This patch uses HAVE_GETPID to guard some subprocess related logic in the RTS. This is required for certain targets like wasm32-wasi, where there isn't a process model at all. - - - - - 50bf5e77 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: IPE.c: don't do mutex stuff when THREADED_RTS is not defined This patch adds the missing THREADED_RTS CPP guard to mutex logic in IPE.c. - - - - - ed3b3da0 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: genericRaise: use exit() instead when not HAVE_RAISE We check existence of raise() in autoconf, and here, if not HAVE_RAISE, we should use exit() instead in genericRaise. - - - - - c0ba1547 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: checkSuid: don't do it when not HAVE_GETUID When getuid() is not present, don't do checkSuid since it doesn't make sense anyway on that target. - - - - - d2d6dfd2 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 placeholder linker This patch adds minimal placeholder linker logic for wasm32, just enough to unblock compiling rts on wasm32. RTS linker functionality is not properly implemented yet for wasm32. - - - - - 65ba3285 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: chdir to PWD on wasm32 This patch adds a wasm32-specific behavior to RtsStartup logic. When the PWD environment variable is present, we chdir() to it first. The point is to workaround an issue in wasi-libc: it's currently not possible to specify the initial working directory, it always defaults to / (in the virtual filesystem mapped from some host directory). For some use cases this is sufficient, but there are some other cases (e.g. in the testsuite) where the program needs to access files outside. - - - - - 65b82542 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: no timer for wasm32 Due to the lack of threads, on wasm32 there can't be a background timer that periodically resets the context switch flag. This patch disables timer for wasm32, and also makes the scheduler default to -C0 on wasm32 to avoid starving threads. - - - - - e007586f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsSymbols: empty RTS_POSIX_ONLY_SYMBOLS for wasm32 The default RTS_POSIX_ONLY_SYMBOLS doesn't make sense on wasm32. - - - - - 0e33f667 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: Schedule: no FORKPROCESS_PRIMOP_SUPPORTED on wasm32 On wasm32 there isn't a process model at all, so no FORKPROCESS_PRIMOP_SUPPORTED. - - - - - 88bbdb31 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: LibffiAdjustor: adapt to ffi_alloc_prep_closure interface for wasm32 libffi-wasm32 only supports non-standard libffi closure api via ffi_alloc_prep_closure(). This patch implements ffi_alloc_prep_closure() via standard libffi closure api on other targets, and uses it to implement adjustor functionality. - - - - - 15138746 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't return memory to OS on wasm32 This patch makes the storage manager not return any memory on wasm32. The detailed reason is described in Note [Megablock allocator on wasm]. - - - - - 631af3cc by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: make flushExec a no-op on wasm32 This patch makes flushExec a no-op on wasm32, since there's no such thing as executable memory on wasm32 in the first place. - - - - - 654a3d46 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: don't call resetTerminalSettings, freeThreadingResources on wasm32 This patch prevents resetTerminalSettings and freeThreadingResources to be called on wasm32, since there is no TTY or threading on wasm32 at all. - - - - - f271e7ca by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: OSThreads.h: stub types for wasm32 This patch defines stub Condition/Mutex/OSThreadId/ThreadLocalKey types for wasm32, just enough to unblock compiling RTS. Any threading-related functionality has been patched to be disabled on wasm32. - - - - - a6ac67b0 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add register mapping for wasm32 This patch adds register mapping logic for wasm32. See Note [Register mapping on WebAssembly] in wasm32 NCG for more description. - - - - - d7b33982 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 specific logic This patch adds the rest of wasm32 specific logic in rts. - - - - - 7f59b0f3 by Cheng Shao at 2022-11-11T00:26:55-05:00 base: fall back to using monotonic clock to emulate cputime on wasm32 On wasm32, we have to fall back to using monotonic clock to emulate cputime, since there's no native support for cputime as a clock id. - - - - - 5fcbae0b by Cheng Shao at 2022-11-11T00:26:55-05:00 base: more autoconf checks for wasm32 This patch adds more autoconf checks to base, since those functions and headers may exist on other POSIX systems but don't exist on wasm32. - - - - - 00a9359f by Cheng Shao at 2022-11-11T00:26:55-05:00 base: avoid using unsupported posix functionality on wasm32 This base patch avoids using unsupported posix functionality on wasm32. - - - - - 34b8f611 by Cheng Shao at 2022-11-11T00:26:55-05:00 autoconf: set CrossCompiling=YES in cross bindist configure This patch fixes the bindist autoconf logic to properly set CrossCompiling=YES when it's a cross GHC bindist. - - - - - 5ebeaa45 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: add util functions for UniqFM and UniqMap This patch adds addToUFM_L (backed by insertLookupWithKey), addToUniqMap_L and intersectUniqMap_C. These UniqFM/UniqMap util functions are used by the wasm32 NCG. - - - - - 177c56c1 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: avoid -Wl,--no-as-needed for wasm32 The driver used to pass -Wl,--no-as-needed for LLD linking. This is actually only supported for ELF targets, and must be avoided when linking for wasm32. - - - - - 06f01c74 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: allow big arith for wasm32 This patch enables Cmm big arithmetic on wasm32, since 64-bit arithmetic can be efficiently lowered to wasm32 opcodes. - - - - - df6bb112 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: pass -Wa,--no-type-check for wasm32 when runAsPhase This patch passes -Wa,--no-type-check for wasm32 when compiling assembly. See the added note for more detailed explanation. - - - - - c1fe4ab6 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: enforce cmm switch planning for wasm32 This patch forcibly enable Cmm switch planning for wasm32, since otherwise the switch tables we generate may exceed the br_table maximum allowed size. - - - - - a8adc71e by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: annotate CmmFileEmbed with blob length This patch adds the blob length field to CmmFileEmbed. The wasm32 NCG needs to know the precise size of each data segment. - - - - - 36340328 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: wasm32 NCG This patch adds the wasm32 NCG. - - - - - 435f42ea by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add wasm32-wasi release bindist job - - - - - d8262fdc by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add a stronger test for cross bindists This commit adds a simple GHC API program that parses and reprints the original hello world program used for basic testing of cross bindists. Before there's full cross-compilation support in the test suite driver, this provides better coverage than the original test. - - - - - 8e6ae882 by Cheng Shao at 2022-11-11T00:26:55-05:00 CODEOWNERS: add wasm-specific maintainers - - - - - 707d5651 by Zubin Duggal at 2022-11-11T00:27:31-05:00 Clarify that LLVM upper bound is non-inclusive during configure (#22411) - - - - - 430eccef by Ben Gamari at 2022-11-11T13:16:45-05:00 rts: Check for program_invocation_short_name via autoconf Instead of assuming support on all Linuxes. - - - - - 6dab0046 by Matthew Pickering at 2022-11-11T13:17:22-05:00 driver: Fix -fdefer-diagnostics flag The `withDeferredDiagnostics` wrapper wasn't doing anything because the session it was modifying wasn't used in hsc_env. Therefore the fix is simple, just push the `getSession` call into the scope of `withDeferredDiagnostics`. Fixes #22391 - - - - - d0c691b6 by Simon Peyton Jones at 2022-11-11T13:18:07-05:00 Add a fast path for data constructor workers See Note [Fast path for data constructors] in GHC.Core.Opt.Simplify.Iteration This bypasses lots of expensive logic, in the special case of applications of data constructors. It is a surprisingly worthwhile improvement, as you can see in the figures below. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Read(normal) -2.0% CoOpt_Singletons(normal) -2.0% ManyConstructors(normal) -1.3% T10421(normal) -1.9% GOOD T10421a(normal) -1.5% T10858(normal) -1.6% T11545(normal) -1.7% T12234(optasm) -1.3% T12425(optasm) -1.9% GOOD T13035(normal) -1.0% GOOD T13056(optasm) -1.8% T13253(normal) -3.3% GOOD T15164(normal) -1.7% T15304(normal) -3.4% T15630(normal) -2.8% T16577(normal) -4.3% GOOD T17096(normal) -1.1% T17516(normal) -3.1% T18282(normal) -1.9% T18304(normal) -1.2% T18698a(normal) -1.2% GOOD T18698b(normal) -1.5% GOOD T18923(normal) -1.3% T1969(normal) -1.3% GOOD T19695(normal) -4.4% GOOD T21839c(normal) -2.7% GOOD T21839r(normal) -2.7% GOOD T4801(normal) -3.8% GOOD T5642(normal) -3.1% GOOD T6048(optasm) -2.5% GOOD T9020(optasm) -2.7% GOOD T9630(normal) -2.1% GOOD T9961(normal) -11.7% GOOD WWRec(normal) -1.0% geo. mean -1.1% minimum -11.7% maximum +0.1% Metric Decrease: T10421 T12425 T13035 T13253 T16577 T18698a T18698b T1969 T19695 T21839c T21839r T4801 T5642 T6048 T9020 T9630 T9961 - - - - - 3c37d30b by Krzysztof Gogolewski at 2022-11-11T19:18:39+01:00 Use a more efficient printer for code generation (#21853) The changes in `GHC.Utils.Outputable` are the bulk of the patch and drive the rest. The types `HLine` and `HDoc` in Outputable can be used instead of `SDoc` and support printing directly to a handle with `bPutHDoc`. See Note [SDoc versus HDoc] and Note [HLine versus HDoc]. The classes `IsLine` and `IsDoc` are used to make the existing code polymorphic over `HLine`/`HDoc` and `SDoc`. This is done for X86, PPC, AArch64, DWARF and dependencies (printing module names, labels etc.). Co-authored-by: Alexis King <lexi.lambda at gmail.com> Metric Decrease: CoOpt_Read ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13379 T18140 T18282 T18698a T18698b T1969 T20049 T21839c T21839r T3064 T3294 T4801 T5321FD T5321Fun T5631 T6048 T783 T9198 T9233 - - - - - 6b92b47f by Matthew Craven at 2022-11-11T18:32:14-05:00 Weaken wrinkle 1 of Note [Scrutinee Constant Folding] Fixes #22375. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 154c70f6 by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Fix fragile RULE setup in GHC.Float In testing my type-vs-constraint patch I found that the handling of Natural literals was very fragile -- and I somehow tripped that fragility in my work. So this patch fixes the fragility. See Note [realToFrac natural-to-float] This made a big (9%) difference in one existing test in perf/should_run/T1-359 Metric Decrease: T10359 - - - - - 778c6adc by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Type vs Constraint: finally nailed This big patch addresses the rats-nest of issues that have plagued us for years, about the relationship between Type and Constraint. See #11715/#21623. The main payload of the patch is: * To introduce CONSTRAINT :: RuntimeRep -> Type * To make TYPE and CONSTRAINT distinct throughout the compiler Two overview Notes in GHC.Builtin.Types.Prim * Note [TYPE and CONSTRAINT] * Note [Type and Constraint are not apart] This is the main complication. The specifics * New primitive types (GHC.Builtin.Types.Prim) - CONSTRAINT - ctArrowTyCon (=>) - tcArrowTyCon (-=>) - ccArrowTyCon (==>) - funTyCon FUN -- Not new See Note [Function type constructors and FunTy] and Note [TYPE and CONSTRAINT] * GHC.Builtin.Types: - New type Constraint = CONSTRAINT LiftedRep - I also stopped nonEmptyTyCon being built-in; it only needs to be wired-in * Exploit the fact that Type and Constraint are distinct throughout GHC - Get rid of tcView in favour of coreView. - Many tcXX functions become XX functions. e.g. tcGetCastedTyVar --> getCastedTyVar * Kill off Note [ForAllTy and typechecker equality], in (old) GHC.Tc.Solver.Canonical. It said that typechecker-equality should ignore the specified/inferred distinction when comparein two ForAllTys. But that wsa only weakly supported and (worse) implies that we need a separate typechecker equality, different from core equality. No no no. * GHC.Core.TyCon: kill off FunTyCon in data TyCon. There was no need for it, and anyway now we have four of them! * GHC.Core.TyCo.Rep: add two FunTyFlags to FunCo See Note [FunCo] in that module. * GHC.Core.Type. Lots and lots of changes driven by adding CONSTRAINT. The key new function is sORTKind_maybe; most other changes are built on top of that. See also `funTyConAppTy_maybe` and `tyConAppFun_maybe`. * Fix a longstanding bug in GHC.Core.Type.typeKind, and Core Lint, in kinding ForAllTys. See new tules (FORALL1) and (FORALL2) in GHC.Core.Type. (The bug was that before (forall (cv::t1 ~# t2). blah), where blah::TYPE IntRep, would get kind (TYPE IntRep), but it should be (TYPE LiftedRep). See Note [Kinding rules for types] in GHC.Core.Type. * GHC.Core.TyCo.Compare is a new module in which we do eqType and cmpType. Of course, no tcEqType any more. * GHC.Core.TyCo.FVs. I moved some free-var-like function into this module: tyConsOfType, visVarsOfType, and occCheckExpand. Refactoring only. * GHC.Builtin.Types. Compiletely re-engineer boxingDataCon_maybe to have one for each /RuntimeRep/, rather than one for each /Type/. This dramatically widens the range of types we can auto-box. See Note [Boxing constructors] in GHC.Builtin.Types The boxing types themselves are declared in library ghc-prim:GHC.Types. GHC.Core.Make. Re-engineer the treatment of "big" tuples (mkBigCoreVarTup etc) GHC.Core.Make, so that it auto-boxes unboxed values and (crucially) types of kind Constraint. That allows the desugaring for arrows to work; it gathers up free variables (including dictionaries) into tuples. See Note [Big tuples] in GHC.Core.Make. There is still work to do here: #22336. But things are better than before. * GHC.Core.Make. We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and aBSENT_CONSTRAINT_ERROR_ID for vaues of kind Constraint. Ditto noInlineId vs noInlieConstraintId in GHC.Types.Id.Make; see Note [inlineId magic]. * GHC.Core.TyCo.Rep. Completely refactor the NthCo coercion. It is now called SelCo, and its fields are much more descriptive than the single Int we used to have. A great improvement. See Note [SelCo] in GHC.Core.TyCo.Rep. * GHC.Core.RoughMap.roughMatchTyConName. Collapse TYPE and CONSTRAINT to a single TyCon, so that the rough-map does not distinguish them. * GHC.Core.DataCon - Mainly just improve documentation * Some significant renamings: GHC.Core.Multiplicity: Many --> ManyTy (easier to grep for) One --> OneTy GHC.Core.TyCo.Rep TyCoBinder --> GHC.Core.Var.PiTyBinder GHC.Core.Var TyCoVarBinder --> ForAllTyBinder AnonArgFlag --> FunTyFlag ArgFlag --> ForAllTyFlag GHC.Core.TyCon TyConTyCoBinder --> TyConPiTyBinder Many functions are renamed in consequence e.g. isinvisibleArgFlag becomes isInvisibleForAllTyFlag, etc * I refactored FunTyFlag (was AnonArgFlag) into a simple, flat data type data FunTyFlag = FTF_T_T -- (->) Type -> Type | FTF_T_C -- (-=>) Type -> Constraint | FTF_C_T -- (=>) Constraint -> Type | FTF_C_C -- (==>) Constraint -> Constraint * GHC.Tc.Errors.Ppr. Some significant refactoring in the TypeEqMisMatch case of pprMismatchMsg. * I made the tyConUnique field of TyCon strict, because I saw code with lots of silly eval's. That revealed that GHC.Settings.Constants.mAX_SUM_SIZE can only be 63, because we pack the sum tag into a 6-bit field. (Lurking bug squashed.) Fixes * #21530 Updates haddock submodule slightly. Performance changes ~~~~~~~~~~~~~~~~~~~ I was worried that compile times would get worse, but after some careful profiling we are down to a geometric mean 0.1% increase in allocation (in perf/compiler). That seems fine. There is a big runtime improvement in T10359 Metric Decrease: LargeRecord MultiLayerModulesTH_OneShot T13386 T13719 Metric Increase: T8095 - - - - - 360f5fec by Simon Peyton Jones at 2022-11-11T23:40:11+00:00 Indent closing "#-}" to silence HLint - - - - - e160cf47 by Krzysztof Gogolewski at 2022-11-12T08:05:28-05:00 Fix merge conflict in T18355.stderr Fixes #22446 - - - - - 294f9073 by Simon Peyton Jones at 2022-11-12T23:14:13+00:00 Fix a trivial typo in dataConNonlinearType Fixes #22416 - - - - - 268a3ce9 by Ben Gamari at 2022-11-14T09:36:57-05:00 eventlog: Ensure that IPE output contains actual info table pointers The refactoring in 866c736e introduced a rather subtle change in the semantics of the IPE eventlog output, changing the eventlog field from encoding info table pointers to "TNTC pointers" (which point to entry code when tables-next-to-code is enabled). Fix this. Fixes #22452. - - - - - d91db679 by Matthew Pickering at 2022-11-14T16:48:10-05:00 testsuite: Add tests for T22347 These are fixed in recent versions but might as well add regression tests. See #22347 - - - - - 8f6c576b by Matthew Pickering at 2022-11-14T16:48:45-05:00 testsuite: Improve output from tests which have failing pre_cmd There are two changes: * If a pre_cmd fails, then don't attempt to run the test. * If a pre_cmd fails, then print the stdout and stderr from running that command (which hopefully has a nice error message). For example: ``` =====> 1 of 1 [0, 0, 0] *** framework failure for test-defaulting-plugin(normal) pre_cmd failed: 2 ** pre_cmd was "$MAKE -s --no-print-directory -C defaulting-plugin package.test-defaulting-plugin TOP={top}". stdout: stderr: DefaultLifted.hs:19:13: error: [GHC-76037] Not in scope: type constructor or class ‘Typ’ Suggested fix: Perhaps use one of these: ‘Type’ (imported from GHC.Tc.Utils.TcType), data constructor ‘Type’ (imported from GHC.Plugins) | 19 | instance Eq Typ where | ^^^ make: *** [Makefile:17: package.test-defaulting-plugin] Error 1 Performance Metrics (test environment: local): ``` Fixes #22329 - - - - - 2b7d5ccc by Madeline Haraj at 2022-11-14T22:44:17+00:00 Implement UNPACK support for sum types. This is based on osa's unpack_sums PR from ages past. The meat of the patch is implemented in dataConArgUnpackSum and described in Note [UNPACK for sum types]. - - - - - 78f7ecb0 by Andreas Klebinger at 2022-11-14T22:20:29-05:00 Expand on the need to clone local binders. Fixes #22402. - - - - - 65ce43cc by Krzysztof Gogolewski at 2022-11-14T22:21:05-05:00 Fix :i Constraint printing "type Constraint = Constraint" Since Constraint became a synonym for CONSTRAINT 'LiftedRep, we need the same code for handling printing as for the synonym Type = TYPE 'LiftedRep. This addresses the same bug as #18594, so I'm reusing the test. - - - - - 94549f8f by ARATA Mizuki at 2022-11-15T21:36:03-05:00 configure: Don't check for an unsupported version of LLVM The upper bound is not inclusive. Fixes #22449 - - - - - 02d3511b by Bodigrim at 2022-11-15T21:36:41-05:00 Fix capitalization in haddock for TestEquality - - - - - 08bf2881 by Cheng Shao at 2022-11-16T09:16:29+00:00 base: make Foreign.Marshal.Pool use RTS internal arena for allocation `Foreign.Marshal.Pool` used to call `malloc` once for each allocation request. Each `Pool` maintained a list of allocated pointers, and traverses the list to `free` each one of those pointers. The extra O(n) overhead is apparently bad for a `Pool` that serves a lot of small allocation requests. This patch uses the RTS internal arena to implement `Pool`, with these benefits: - Gets rid of the extra O(n) overhead. - The RTS arena is simply a bump allocator backed by the block allocator, each allocation request is likely faster than a libc `malloc` call. Closes #14762 #18338. - - - - - 37cfe3c0 by Krzysztof Gogolewski at 2022-11-16T14:50:06-05:00 Misc cleanup * Replace catMaybes . map f with mapMaybe f * Use concatFS to concatenate multiple FastStrings * Fix documentation of -exclude-module * Cleanup getIgnoreCount in GHCi.UI - - - - - b0ac3813 by Lawton Nichols at 2022-11-19T03:22:14-05:00 Give better errors for code corrupted by Unicode smart quotes (#21843) Previously, we emitted a generic and potentially confusing error during lexical analysis on programs containing smart quotes (“/”/‘/’). This commit adds smart quote-aware lexer errors. - - - - - cb8430f8 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make OpaqueNo* tests less noisy to unrelated changes - - - - - b1a8af69 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Simplifier: Consider `seq` as a `BoringCtxt` (#22317) See `Note [Seq is boring]` for the rationale. Fixes #22317. - - - - - 9fd11585 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make T21839c's ghc/max threshold more forgiving - - - - - 4b6251ab by Simon Peyton Jones at 2022-11-19T03:23:24-05:00 Be more careful when reporting unbound RULE binders See Note [Variables unbound on the LHS] in GHC.HsToCore.Binds. Fixes #22471. - - - - - e8f2b80d by Peter Trommler at 2022-11-19T03:23:59-05:00 PPC NCG: Fix generating assembler code Fixes #22479 - - - - - f2f9ef07 by Bodigrim at 2022-11-20T18:39:30-05:00 Extend documentation for Data.IORef - - - - - ef511b23 by Simon Peyton Jones at 2022-11-20T18:40:05-05:00 Buglet in GHC.Tc.Module.checkBootTyCon This lurking bug used the wrong function to compare two types in GHC.Tc.Module.checkBootTyCon It's hard to trigger the bug, which only came up during !9343, so there's no regression test in this MR. - - - - - 451aeac3 by Bodigrim at 2022-11-20T18:40:44-05:00 Add since pragmas for c_interruptible_open and hostIsThreaded - - - - - 8d6aaa49 by Duncan Coutts at 2022-11-22T02:06:16-05:00 Introduce CapIOManager as the per-cap I/O mangager state Rather than each I/O manager adding things into the Capability structure ad-hoc, we should have a common CapIOManager iomgr member of the Capability structure, with a common interface to initialise etc. The content of the CapIOManager struct will be defined differently for each I/O manager implementation. Eventually we should be able to have the CapIOManager be opaque to the rest of the RTS, and known just to the I/O manager implementation. We plan for that by making the Capability contain a pointer to the CapIOManager rather than containing the structure directly. Initially just move the Unix threaded I/O manager's control FD. - - - - - 8901285e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Add hook markCapabilityIOManager To allow I/O managers to have GC roots in the Capability, within the CapIOManager structure. Not yet used in this patch. - - - - - 5cf709c5 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move APPEND_TO_BLOCKED_QUEUE from cmm to C The I/O and delay blocking primitives for the non-threaded way currently access the blocked_queue and sleeping_queue directly. We want to move where those queues are to make their ownership clearer: to have them clearly belong to the I/O manager impls rather than to the scheduler. Ultimately we will want to change their representation too. It's inconvenient to do that if these queues are accessed directly from cmm code. So as a first step, replace the APPEND_TO_BLOCKED_QUEUE with a C version appendToIOBlockedQueue(), and replace the open-coded sleeping_queue insertion with insertIntoSleepingQueue(). - - - - - ced9acdb by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move {blocked,sleeping}_queue from scheduler global vars to CapIOManager The blocked_queue_{hd,tl} and the sleeping_queue are currently cooperatively managed between the scheduler and (some but not all of) the non-threaded I/O manager implementations. They lived as global vars with the scheduler, but are poked by I/O primops and the I/O manager backends. This patch is a step on the path towards making the management of I/O or timer blocking belong to the I/O managers and not the scheduler. Specifically, this patch moves the {blocked,sleeping}_queue from being global vars in the scheduler to being members of the CapIOManager struct within each Capability. They are not yet exclusively used by the I/O managers: they are still poked from a couple other places, notably in the scheduler before calling awaitEvent. - - - - - 0f68919e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Remove the now-unused markScheduler The global vars {blocked,sleeping}_queue are now in the Capability and so get marked there via markCapabilityIOManager. - - - - - 39a91f60 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move macros for checking for pending IO or timers from Schedule.h to Schedule.c and IOManager.h This is just moving, the next step will be to rejig them slightly. For the non-threaded RTS the scheduler needs to be able to test for there being pending I/O operation or pending timers. The implementation of these tests should really be considered to be part of the I/O managers and not part of the scheduler. - - - - - 664b034b by Duncan Coutts at 2022-11-22T02:06:17-05:00 Replace EMPTY_{BLOCKED,SLEEPING}_QUEUE macros by function These are the macros originaly from Scheduler.h, previously moved to IOManager.h, and now replaced with a single inline function anyPendingTimeoutsOrIO(). We can use a single function since the two macros were always checked together. Note that since anyPendingTimeoutsOrIO is defined for all IO manager cases, including threaded, we do not need to guard its use by cpp #if !defined(THREADED_RTS) - - - - - 32946220 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Expand emptyThreadQueues inline for clarity It was not really adding anything. The name no longer meant anything since those I/O and timeout queues do not belong to the scheuler. In one of the two places it was used, the comments already had to explain what it did, whereas now the code matches the comment nicely. - - - - - 9943baf9 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move the awaitEvent declaration into IOManager.h And add or adjust comments at the use sites of awaitEvent. - - - - - 054dcc9d by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to awaitEvent It is currently only used in the non-threaded RTS so it works to use MainCapability, but it's a bit nicer to pass the cap anyway. It's certainly shorter. - - - - - 667fe5a4 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to appendToIOBlockedQueue And to insertIntoSleepingQueue. Again, it's a bit cleaner and simpler though not strictly necessary given that these primops are currently only used in the non-threaded RTS. - - - - - 7181b074 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Reveiew feedback: improve one of the TODO comments The one about the nonsense (const False) test on WinIO for there being any IO or timers pending, leading to unnecessary complication later in the scheduler. - - - - - e5b68183 by Andreas Klebinger at 2022-11-22T02:06:52-05:00 Optimize getLevity. Avoid the intermediate data structures allocated by splitTyConApp. This avoids ~0.5% of allocations for a build using -O2. Fixes #22254 - - - - - de5fb348 by Andreas Klebinger at 2022-11-22T02:07:28-05:00 hadrian:Set TNTC when running testsuite. - - - - - 9d61c182 by Oleg Grenrus at 2022-11-22T15:59:34-05:00 Add unsafePtrEquality# restricted to UnliftedTypes - - - - - e817c871 by Jonathan Dowland at 2022-11-22T16:00:14-05:00 utils/unlit: adjust parser to match Report spec The Haskell 2010 Report says that, for Latex-style Literate format, "Program code begins on the first line following a line that begins \begin{code}". (This is unchanged from the 98 Report) However the unlit.c implementation only matches a line that contains "\begin{code}" and nothing else. One consequence of this is that one cannot suffix Latex options to the code environment. I.e., this does not work: \begin{code}[label=foo,caption=Foo Code] Adjust the matcher to conform to the specification from the Report. The Haskell Wiki currently recommends suffixing a '%' to \begin{code} in order to deliberately hide a code block from Haskell. This is bad advice, as it's relying on an implementation quirk rather than specified behaviour. None-the-less, some people have tried to use it, c.f. <https://mail.haskell.org/pipermail/haskell-cafe/2009-September/066780.html> An alternative solution is to define a separate, equivalent Latex environment to "code", that is functionally identical in Latex but ignored by unlit. This should not be a burden: users are required to manually define the code environment anyway, as it is not provided by the Latex verbatim or lstlistings packages usually used for presenting code in documents. Fixes #3549. - - - - - 0b7fef11 by Teo Camarasu at 2022-11-23T12:44:33-05:00 Fix eventlog all option Previously it didn't enable/disable nonmoving_gc and ticky event types Fixes #21813 - - - - - 04d0618c by Arnaud Spiwack at 2022-11-23T12:45:14-05:00 Expand Note [Linear types] with the stance on linting linearity Per the discussion on #22123 - - - - - e1538516 by Lawton Nichols at 2022-11-23T12:45:55-05:00 Add documentation on custom Prelude modules (#22228) Specifically, custom Prelude modules that are named `Prelude`. - - - - - b5c71454 by Sylvain Henry at 2022-11-23T12:46:35-05:00 Don't let configure perform trivial substitutions (#21846) Hadrian now performs substitutions, especially to generate .cabal files from .cabal.in files. Two benefits: 1. We won't have to re-configure when we modify thing.cabal.in. Hadrian will take care of this for us. 2. It paves the way to allow the same package to be configured differently by Hadrian in the same session. This will be useful to fix #19174: we want to build a stage2 cross-compiler for the host platform and a stage1 compiler for the cross target platform in the same Hadrian session. - - - - - 99aca26b by nineonine at 2022-11-23T12:47:11-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043) Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043 - - - - - 040bfdc3 by M Farkas-Dyck at 2022-11-23T21:59:03-05:00 Scrub some no-warning pragmas. - - - - - 178c1fd8 by Vladislav Zavialov at 2022-11-23T21:59:39-05:00 Check if the SDoc starts with a single quote (#22488) This patch fixes pretty-printing of character literals inside promoted lists and tuples. When we pretty-print a promoted list or tuple whose first element starts with a single quote, we want to add a space between the opening bracket and the element: '[True] -- ok '[ 'True] -- ok '['True] -- not ok If we don't add the space, we accidentally produce a character literal '['. Before this patch, pprSpaceIfPromotedTyCon inspected the type as an AST and tried to guess if it would be rendered with a single quote. However, it missed the case when the inner type was itself a character literal: '[ 'x'] -- ok '['x'] -- not ok Instead of adding this particular case, I opted for a more future-proof solution: check the SDoc directly. This way we can detect if the single quote is actually there instead of trying to predict it from the AST. The new function is called spaceIfSingleQuote. - - - - - 11627c42 by Matthew Pickering at 2022-11-23T22:00:15-05:00 notes: Fix references to HPT space leak note Updating this note was missed when updating the HPT to the HUG. Fixes #22477 - - - - - 86ff1523 by Andrei Borzenkov at 2022-11-24T17:24:51-05:00 Convert diagnostics in GHC.Rename.Expr to proper TcRnMessage (#20115) Problem: avoid usage of TcRnMessageUnknown Solution: The following `TcRnMessage` messages has been introduced: TcRnNoRebindableSyntaxRecordDot TcRnNoFieldPunsRecordDot TcRnIllegalStaticExpression TcRnIllegalStaticFormInSplice TcRnListComprehensionDuplicateBinding TcRnEmptyStmtsGroup TcRnLastStmtNotExpr TcRnUnexpectedStatementInContext TcRnIllegalTupleSection TcRnIllegalImplicitParameterBindings TcRnSectionWithoutParentheses Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - d198a19a by Cheng Shao at 2022-11-24T17:25:29-05:00 rts: fix missing Arena.h symbols in RtsSymbols.c It was an unfortunate oversight in !8961 and broke devel2 builds. - - - - - 5943e739 by Bodigrim at 2022-11-25T04:38:28-05:00 Assorted fixes to avoid Data.List.{head,tail} - - - - - 1f1b99b8 by sheaf at 2022-11-25T04:38:28-05:00 Review suggestions for assorted fixes to avoid Data.List.{head,tail} - - - - - 13d627bb by Vladislav Zavialov at 2022-11-25T04:39:04-05:00 Print unticked promoted data constructors (#20531) Before this patch, GHC unconditionally printed ticks before promoted data constructors: ghci> type T = True -- unticked (user-written) ghci> :kind! T T :: Bool = 'True -- ticked (compiler output) After this patch, GHC prints ticks only when necessary: ghci> type F = False -- unticked (user-written) ghci> :kind! F F :: Bool = False -- unticked (compiler output) ghci> data False -- introduce ambiguity ghci> :kind! F F :: Bool = 'False -- ticked by necessity (compiler output) The old behavior can be enabled by -fprint-redundant-promotion-ticks. Summary of changes: * Rename PrintUnqualified to NamePprCtx * Add QueryPromotionTick to it * Consult the GlobalRdrEnv to decide whether to print a tick (see mkPromTick) * Introduce -fprint-redundant-promotion-ticks Co-authored-by: Artyom Kuznetsov <hi at wzrd.ht> - - - - - d10dc6bd by Simon Peyton Jones at 2022-11-25T22:31:27+00:00 Fix decomposition of TyConApps Ticket #22331 showed that we were being too eager to decompose a Wanted TyConApp, leading to incompleteness in the solver. To understand all this I ended up doing a substantial rewrite of the old Note [Decomposing equalities], now reborn as Note [Decomposing TyConApp equalities]. Plus rewrites of other related Notes. The actual fix is very minor and actually simplifies the code: in `can_decompose` in `GHC.Tc.Solver.Canonical.canTyConApp`, we now call `noMatchableIrreds`. A closely related refactor: we stop trying to use the same "no matchable givens" function here as in `matchClassInst`. Instead split into two much simpler functions. - - - - - 2da5c38a by Will Hawkins at 2022-11-26T04:05:04-05:00 Redirect output of musttail attribute test Compilation output from test for support of musttail attribute leaked to the console. - - - - - 0eb1c331 by Cheng Shao at 2022-11-28T08:55:53+00:00 Move hs_mulIntMayOflo cbits to ghc-prim It's only used by wasm NCG at the moment, but ghc-prim is a more reasonable place for hosting out-of-line primops. Also, we only need a single version of hs_mulIntMayOflo. - - - - - 36b53a9d by Cheng Shao at 2022-11-28T09:05:57+00:00 compiler: generate ccalls for clz/ctz/popcnt in wasm NCG We used to generate a single wasm clz/ctz/popcnt opcode, but it's wrong when it comes to subwords, so might as well generate ccalls for them. See #22470 for details. - - - - - d4134e92 by Cheng Shao at 2022-11-28T23:48:14-05:00 compiler: remove unused MO_U_MulMayOflo We actually only emit MO_S_MulMayOflo and never emit MO_U_MulMayOflo anywhere. - - - - - 8d15eadc by Apoorv Ingle at 2022-11-29T03:09:31-05:00 Killing cc_fundeps, streamlining kind equality orientation, and type equality processing order Fixes: #217093 Associated to #19415 This change * Flips the orientation of the the generated kind equality coercion in canEqLHSHetero; * Removes `cc_fundeps` in CDictCan as the check was incomplete; * Changes `canDecomposableTyConAppOk` to ensure we process kind equalities before type equalities and avoiding a call to `canEqLHSHetero` while processing wanted TyConApp equalities * Adds 2 new tests for validating the change - testsuites/typecheck/should_compile/T21703.hs and - testsuites/typecheck/should_fail/T19415b.hs (a simpler version of T19415.hs) * Misc: Due to the change in the equality direction some error messages now have flipped type mismatch errors * Changes in Notes: - Note [Fundeps with instances, and equality orientation] supercedes Note [Fundeps with instances] - Added Note [Kind Equality Orientation] to visualize the kind flipping - Added Note [Decomposing Dependent TyCons and Processing Wanted Equalties] - - - - - 646969d4 by Krzysztof Gogolewski at 2022-11-29T03:10:13-05:00 Change printing of sized literals to match the proposal Literals in Core were printed as e.g. 0xFF#16 :: Int16#. The proposal 451 now specifies syntax 0xFF#Int16. This change affects the Core printer only - more to be done later. Part of #21422. - - - - - 02e282ec by Simon Peyton Jones at 2022-11-29T03:10:48-05:00 Be a bit more selective about floating bottoming expressions This MR arranges to float a bottoming expression to the top only if it escapes a value lambda. See #22494 and Note [Floating to the top] in SetLevels. This has a generally beneficial effect in nofib +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || -0.93% | | imaginary/rfib || -0.05% | | real/fem || -0.03% | | real/fluid || -0.01% | | real/fulsom || +0.05% | | real/gamteb || -0.27% | | real/gg || -0.10% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/scs || -11.13% | | shootout/k-nucleotide || -0.01% | | shootout/n-body || -0.08% | | shootout/reverse-complement || -0.00% | | shootout/spectral-norm || -0.02% | | spectral/fibheaps || -0.20% | | spectral/hartel/fft || -1.04% | | spectral/hartel/solid || +0.33% | | spectral/hartel/wave4main || -0.35% | | spectral/mate || +0.76% | +===============================++==========+ | geom mean || -0.12% | The effect on compile time is generally slightly beneficial Metrics: compile_time/bytes allocated ---------------------------------------------- MultiLayerModulesTH_OneShot(normal) +0.3% PmSeriesG(normal) -0.2% PmSeriesT(normal) -0.1% T10421(normal) -0.1% T10421a(normal) -0.1% T10858(normal) -0.1% T11276(normal) -0.1% T11303b(normal) -0.2% T11545(normal) -0.1% T11822(normal) -0.1% T12150(optasm) -0.1% T12234(optasm) -0.3% T13035(normal) -0.2% T16190(normal) -0.1% T16875(normal) -0.4% T17836b(normal) -0.2% T17977(normal) -0.2% T17977b(normal) -0.2% T18140(normal) -0.1% T18282(normal) -0.1% T18304(normal) -0.2% T18698a(normal) -0.1% T18923(normal) -0.1% T20049(normal) -0.1% T21839r(normal) -0.1% T5837(normal) -0.4% T6048(optasm) +3.2% BAD T9198(normal) -0.2% T9630(normal) -0.1% TcPlugin_RewritePerf(normal) -0.4% hard_hole_fits(normal) -0.1% geo. mean -0.0% minimum -0.4% maximum +3.2% The T6048 outlier is hard to pin down, but it may be the effect of reading in more interface files definitions. It's a small program for which compile time is very short, so I'm not bothered about it. Metric Increase: T6048 - - - - - ab23dc5e by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Mark unpack_sums_6 as fragile due to #22504 This test is explicitly dependent upon runtime, which is generally not appropriate given that the testsuite is run in parallel and generally saturates the CPU. - - - - - def47dd3 by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Don't use grep -q in unpack_sums_7 `grep -q` closes stdin as soon as it finds the pattern it is looking for, resulting in #22484. - - - - - cc25d52e by Sylvain Henry at 2022-11-29T09:44:31+01:00 Add Javascript backend Add JS backend adapted from the GHCJS project by Luite Stegeman. Some features haven't been ported or implemented yet. Tests for these features have been disabled with an associated gitlab ticket. Bump array submodule Work funded by IOG. Co-authored-by: Jeffrey Young <jeffrey.young at iohk.io> Co-authored-by: Luite Stegeman <stegeman at gmail.com> Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 68c966cd by sheaf at 2022-11-30T09:31:25-05:00 Fix @since annotations on WithDict and Coercible Fixes #22453 - - - - - a3a8e9e9 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Be more careful in GHC.Tc.Solver.Interact.solveOneFromTheOther We were failing to account for the cc_pend_sc flag in this important function, with the result that we expanded superclasses forever. Fixes #22516. - - - - - a9d9b8c0 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Use mkNakedFunTy in tcPatSynSig As #22521 showed, in tcPatSynSig we make a "fake type" to kind-generalise; and that type has unzonked type variables in it. So we must not use `mkFunTy` (which checks FunTy's invariants) via `mkPhiTy` when building this type. Instead we need to use `mkNakedFunTy`. Easy fix. - - - - - 31462d98 by Andreas Klebinger at 2022-11-30T14:50:58-05:00 Properly cast values when writing/reading unboxed sums. Unboxed sums might store a Int8# value as Int64#. This patch makes sure we keep track of the actual value type. See Note [Casting slot arguments] for the details. - - - - - 10a2a7de by Oleg Grenrus at 2022-11-30T14:51:39-05:00 Move Void to GHC.Base... This change would allow `Void` to be used deeper in module graph. For example exported from `Prelude` (though that might be already possible). Also this change includes a change `stimes @Void _ x = x`, https://github.com/haskell/core-libraries-committee/issues/95 While the above is not required, maintaining old stimes behavior would be tricky as `GHC.Base` doesn't know about `Num` or `Integral`, which would require more hs-boot files. - - - - - b4cfa8e2 by Sebastian Graf at 2022-11-30T14:52:24-05:00 DmdAnal: Reflect the `seq` of strict fields of a DataCon worker (#22475) See the updated `Note [Data-con worker strictness]` and the new `Note [Demand transformer for data constructors]`. Fixes #22475. - - - - - d87f28d8 by Baldur Blöndal at 2022-11-30T21:16:36+01:00 Make Functor a quantified superclass of Bifunctor. See https://github.com/haskell/core-libraries-committee/issues/91 for discussion. This change relates Bifunctor with Functor by requiring second = fmap. Moreover this change is a step towards unblocking the major version bump of bifunctors and profunctors to major version 6. This paves the way to move the Profunctor class into base. For that Functor first similarly becomes a superclass of Profunctor in the new major version 6. - - - - - 72cf4c5d by doyougnu at 2022-12-01T12:36:44-05:00 FastString: SAT bucket_match Metric Decrease: MultiLayerModulesTH_OneShot - - - - - afc2540d by Simon Peyton Jones at 2022-12-01T12:37:20-05:00 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 - - - - - 81eeec7f by M Farkas-Dyck at 2022-12-01T12:37:56-05:00 CI: Forbid the fully static build on Alpine to fail. To do so, we mark some tests broken in this configuration. - - - - - c5d1bf29 by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Remove ARMv7 jobs These jobs fail (and are allowed to fail) nearly every time. Soon they won't even be able to run at all, as we won't currently have runners that can run them. Fixing the latter problem is tracked in #22409. I went ahead and removed all settings and configurations. - - - - - d82992fd by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Fix CI lint Failure was introduced by conflicting changes to gen_ci.hs that did *not* trigger git conflicts. - - - - - ce126993 by Simon Peyton Jones at 2022-12-02T01:22:12-05:00 Refactor TyCon to have a top-level product This patch changes the representation of TyCon so that it has a top-level product type, with a field that gives the details (newtype, type family etc), #22458. Not much change in allocation, but execution seems to be a bit faster. Includes a change to the haddock submodule to adjust for API changes. - - - - - 74c767df by Matthew Pickering at 2022-12-02T01:22:48-05:00 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 - - - - - 85ecc1a0 by Matthew Pickering at 2022-12-02T19:46:43-05:00 Add special case for :Main module in `GHC.IfaceToCore.mk_top_id` See Note [Root-main Id] The `:Main` special binding is actually defined in the current module (hence don't go looking for it externally) but the module name is rOOT_MAIN rather than the current module so we need this special case. There was already some similar logic in `GHC.Rename.Env` for External Core, but now the "External Core" is in interface files it needs to be moved here instead. Fixes #22405 - - - - - 108c319f by Krzysztof Gogolewski at 2022-12-02T19:47:18-05:00 Fix linearity checking in Lint Lint was not able to see that x*y <= x*y, because this inequality was decomposed to x <= x*y && y <= x*y, but there was no rule to see that x <= x*y. Fixes #22546. - - - - - bb674262 by Bryan Richter at 2022-12-03T04:38:46-05:00 Mark T16916 fragile See https://gitlab.haskell.org/ghc/ghc/-/issues/16966 - - - - - 5d267d46 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 Refactor: FreshOrReuse instead of addTyClTyVarBinds This is a refactoring that should have no effect on observable behavior. Prior to this change, GHC.HsToCore.Quote contained a few closely related functions to process type variable bindings: addSimpleTyVarBinds, addHsTyVarBinds, addQTyVarBinds, and addTyClTyVarBinds. We can classify them by their input type and name generation strategy: Fresh names only Reuse bound names +---------------------+-------------------+ [Name] | addSimpleTyVarBinds | | [LHsTyVarBndr flag GhcRn] | addHsTyVarBinds | | LHsQTyVars GhcRn | addQTyVarBinds | addTyClTyVarBinds | +---------------------+-------------------+ Note how two functions are missing. Because of this omission, there were two places where a LHsQTyVars value was constructed just to be able to pass it to addTyClTyVarBinds: 1. mk_qtvs in addHsOuterFamEqnTyVarBinds -- bad 2. mkHsQTvs in repFamilyDecl -- bad This prevented me from making other changes to LHsQTyVars, so the main goal of this refactoring is to get rid of those workarounds. The most direct solution would be to define the missing functions. But that would lead to a certain amount of code duplication. To avoid code duplication, I factored out the name generation strategy into a function parameter: data FreshOrReuse = FreshNamesOnly | ReuseBoundNames addSimpleTyVarBinds :: FreshOrReuse -> ... addHsTyVarBinds :: FreshOrReuse -> ... addQTyVarBinds :: FreshOrReuse -> ... - - - - - c189b831 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 addHsOuterFamEqnTyVarBinds: use FreshNamesOnly for explicit binders Consider this example: [d| instance forall a. C [a] where type forall b. G [a] b = Proxy b |] When we process "forall b." in the associated type instance, it is unambiguously the binding site for "b" and we want a fresh name for it. Therefore, FreshNamesOnly is more fitting than ReuseBoundNames. This should not have any observable effect but it avoids pointless lookups in the MetaEnv. - - - - - 42512264 by Ross Paterson at 2022-12-03T10:32:45+00:00 Handle type data declarations in Template Haskell quotations and splices (fixes #22500) This adds a TypeDataD constructor to the Template Haskell Dec type, and ensures that the constructors it contains go in the TyCls namespace. - - - - - 1a767fa3 by Vladislav Zavialov at 2022-12-05T05:18:50-05:00 Add BufSpan to EpaLocation (#22319, #22558) The key part of this patch is the change to mkTokenLocation: - mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb) mkTokenLocation used to discard the BufSpan, but now it is saved and can be retrieved from LHsToken or LHsUniToken. This is made possible by the following change to EpaLocation: - data EpaLocation = EpaSpan !RealSrcSpan + data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | ... The end goal is to make use of the BufSpan in Parser/PostProcess/Haddock. - - - - - cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - d0298711 by Matthew Pickering at 2023-03-08T16:48:20+00:00 Add support for ghc-debug to ghc executable - - - - - 13 changed files: - − .appveyor.sh - .editorconfig - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - + .gitlab/hello.hs - + .gitlab/hie.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6c50927ecae1443f8291133291d166aedde0b6d8...d029871159828dc96f8994e4bd2a093dd7490930 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6c50927ecae1443f8291133291d166aedde0b6d8...d029871159828dc96f8994e4bd2a093dd7490930 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 16:56:46 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 08 Mar 2023 11:56:46 -0500 Subject: [Git][ghc/ghc][wip/t21766] 23 commits: Add `Data.Functor.unzip` Message-ID: <6408be4ef2033_2c78e9210cbf68500945@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 01b5968d by Finley McIlwaine at 2023-03-08T09:50:42-07:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 6636b1c0 by Finley McIlwaine at 2023-03-08T09:50:42-07:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - 88043af8 by Finley McIlwaine at 2023-03-08T09:50:42-07:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5d784ecc by Finley McIlwaine at 2023-03-08T09:50:42-07:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - da430b63 by Finley McIlwaine at 2023-03-08T09:50:42-07:00 Add note describing IPE data compression See ticket #21766 - - - - - 0bc041dd by Finley McIlwaine at 2023-03-08T09:50:42-07:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 1a88bd41 by Finley McIlwaine at 2023-03-08T09:50:42-07:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - 158f7168 by Finley McIlwaine at 2023-03-08T09:50:42-07:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - d8f35c53 by Finley McIlwaine at 2023-03-08T09:50:42-07:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 528bb8dd by Finley McIlwaine at 2023-03-08T09:50:42-07:00 Update user's guide and release notes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. See ticket #21766 - - - - - 6bdab8c8 by Finley McIlwaine at 2023-03-08T09:50:42-07:00 Fix multiline string in `IPE.c` - - - - - 7ba01a5a by Finley McIlwaine at 2023-03-08T09:50:42-07:00 Optional static linking of libzstd Allow for libzstd to be statically linked with a `--enable-static-libzstd` configure flag. Not supported on darwin due to incompatibility with `:x.a` linker flags. - - - - - d96ce5a4 by Finley McIlwaine at 2023-03-08T09:50:42-07:00 Detect darwin for `--enable-static-libzstd` Update users guide to note the optional static linking of libzstd, and update ci-images rev to get libzstd in debian images on CI - - - - - 4a809594 by Finley McIlwaine at 2023-03-08T09:56:12-07:00 Revert `+ipe` enabled CI jobs for ~IPE label - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - libraries/base/Data/Functor.hs - libraries/base/Debug/Trace.hs - libraries/base/changelog.md - m4/fp_find_libnuma.m4 - + m4/fp_find_libzstd.m4 - rts/IPE.c - rts/IPE.h - rts/include/rts/IPE.h - rts/linker/Elf.c - rts/rts.cabal.in - + testsuite/tests/bytecode/T23068.hs - + testsuite/tests/bytecode/T23068.script - + testsuite/tests/bytecode/T23068.stdout - + testsuite/tests/bytecode/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0232df2f562260fa1b025fa1df91b03f5cc1bd40...4a8095948fdfb562f6802869a506eb4cd572ab43 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0232df2f562260fa1b025fa1df91b03f5cc1bd40...4a8095948fdfb562f6802869a506eb4cd572ab43 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 17:02:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Mar 2023 12:02:29 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 51 commits: Change hostSupportsRPaths to report False on OpenBSD Message-ID: <6408bfa53c8bd_2c78e9213380a8506768@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 1356ce9f by Ben Gamari at 2023-03-08T12:02:20-05:00 rts: Drop redundant prototype - - - - - dccb8a90 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Fix style - - - - - a89c6365 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Deduplicate assertion - - - - - 4c61f84f by Ben Gamari at 2023-03-08T12:02:20-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - b60e2080 by Ben Gamari at 2023-03-08T12:02:20-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - daa0847b by Ben Gamari at 2023-03-08T12:02:20-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 77b85f38 by Ben Gamari at 2023-03-08T12:02:20-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - e6c1d690 by Ben Gamari at 2023-03-08T12:02:20-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 5364f528 by Ben Gamari at 2023-03-08T12:02:20-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7b1c2627 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 01dbcf59 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Clarify comment - - - - - bd21d1ef by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - b0d1aac3 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 2f04b0de by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - 8b8ac042 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 77f55a35 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 0265888e by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 8e0da7f1 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 46b15add by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Assert state of swept segments - - - - - 8c3f6100 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - 4a76d689 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 662daa7f by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - 79aa0eb9 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Post-sweep sanity checking - - - - - dff8f1eb by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Avoid n_caps race - - - - - 26c62a96 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 97eaaae8 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 04612d9a by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - 6b343de9 by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 39324755 by Ben Gamari at 2023-03-08T12:02:20-05:00 rts: Reenable assertion - - - - - 68bb840d by Ben Gamari at 2023-03-08T12:02:20-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - a9980e9b by Ben Gamari at 2023-03-08T12:02:21-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 95a7c6e7 by Ben Gamari at 2023-03-08T12:02:21-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 39242ee7 by Ben Gamari at 2023-03-08T12:02:21-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 16bebebe by Ben Gamari at 2023-03-08T12:02:21-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - f35d4a1d by Ben Gamari at 2023-03-08T12:02:21-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - dee73aa9 by Ben Gamari at 2023-03-08T12:02:21-05:00 nonmoving: Fix unregisterised build - - - - - 4f65c268 by Ben Gamari at 2023-03-08T12:02:21-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - d451f2c6 by Ben Gamari at 2023-03-08T12:02:21-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 810b3c78 by Ben Gamari at 2023-03-08T12:02:21-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - faed3751 by Ben Gamari at 2023-03-08T12:02:21-05:00 nonmoving: Move allocator into new source file - - - - - 722d40f4 by Ben Gamari at 2023-03-08T12:02:21-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 3f89c320 by Ben Gamari at 2023-03-08T12:02:21-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - fc21ed29 by Ben Gamari at 2023-03-08T12:02:21-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - c9093853 by Ben Gamari at 2023-03-08T12:02:21-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - 284ca5a4 by Ben Gamari at 2023-03-08T12:02:21-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - ec3af0e0 by Ben Gamari at 2023-03-08T12:02:21-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - cf320d63 by Ben Gamari at 2023-03-08T12:02:21-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - f4d111be by Ben Gamari at 2023-03-08T12:02:21-05:00 nonmoving: Non-concurrent collection - - - - - 8d2efa2c by Alexis King at 2023-03-08T12:02:23-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/StgToByteCode.hs - hadrian/doc/user-settings.md - hadrian/src/Expression.hs - hadrian/src/Flavour.hs - hadrian/src/Oracles/Flavour.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Quick.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-heap/tests/all.T - rts/Capability.c - rts/Capability.h - rts/PrimOps.cmm - rts/RtsStartup.c - rts/RtsUtils.h - rts/Schedule.c - rts/Sparks.h - rts/ThreadLabels.c - rts/include/rts/storage/GC.h - rts/include/rts/storage/MBlock.h - rts/rts.cabal.in - rts/sm/BlockAlloc.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GC.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b140966379c6938dea3e53b39f0783517cb17bff...8d2efa2cc0476f73ba04e9fa45907a59ebe7a6d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b140966379c6938dea3e53b39f0783517cb17bff...8d2efa2cc0476f73ba04e9fa45907a59ebe7a6d7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 17:02:57 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 08 Mar 2023 12:02:57 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T19627 Message-ID: <6408bfc15fd85_2c78e92133db5c512275@gitlab.mail> Apoorv Ingle pushed new branch wip/T19627 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T19627 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 17:11:12 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Wed, 08 Mar 2023 12:11:12 -0500 Subject: [Git][ghc/ghc][wip/js-exports] JS Prims: fix some implementations Message-ID: <6408c1b0b76f6_2c78e9217ad6105160a@gitlab.mail> Josh Meredith pushed to branch wip/js-exports at Glasgow Haskell Compiler / GHC Commits: 88cd4bba by Josh Meredith at 2023-03-08T17:10:37+00:00 JS Prims: fix some implementations - - - - - 4 changed files: - compiler/GHC/HsToCore/Foreign/JavaScript.hs - libraries/base/GHC/JS/Foreign/Callback.hs - libraries/base/GHC/JS/Prim.hs - libraries/base/base.cabal Changes: ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -639,7 +639,7 @@ jsResultWrapper result_ty | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey = do -- result_id <- newSysLocalDs boolTy ccall_uniq <- newUnique - let forceBool e = mkJsCall ccall_uniq (fsLit "$r = !(!$1)") [e] boolTy + let forceBool e = mkJsCall ccall_uniq (fsLit "(($1) => { return !(!$1); })") [e] boolTy return (Just intPrimTy, \e -> forceBool e) ===================================== libraries/base/GHC/JS/Foreign/Callback.hs ===================================== @@ -1,5 +1,3 @@ -{-# LANGUAGE MagicHash #-} - module GHC.JS.Foreign.Callback ( Callback , OnBlocked(..) @@ -31,7 +29,7 @@ import Unsafe.Coerce data OnBlocked = ContinueAsync | ThrowWouldBlock deriving (Eq) -data Callback a = Callback JSVal# deriving Typeable +newtype Callback a = Callback JSVal deriving Typeable {- | When you create a callback, the Haskell runtime stores a reference to ===================================== libraries/base/GHC/JS/Prim.hs ===================================== @@ -280,10 +280,10 @@ foreign import javascript unsafe "(($1) => { return ($1 === undefined); })" foreign import javascript unsafe "(($1) => { return ($r = typeof($1) === 'number' ? ($1|0) : 0;); })" js_fromJSInt :: JSVal -> Int -foreign import javascript unsafe "(($1) => { return ($r = $1;); })" +foreign import javascript unsafe "(($1) => { return $1; })" js_toJSInt :: Int -> JSVal -foreign import javascript unsafe "$r = null;" +foreign import javascript unsafe "(() => { return null; })" js_null :: JSVal foreign import javascript unsafe "(($1,$2) => { return $1[h$fromHsString($2)]; })" @@ -307,7 +307,6 @@ foreign import javascript unsafe "(($1,$2_1,$2_2) => { return $1[h$decodeUtf8z($ foreign import javascript unsafe "(($1_1,$1_2) => { return h$decodeUtf8z($1_1, $1_2); })" js_unpackJSStringUtf8## :: Addr# -> State# s -> (# State# s, JSVal# #) - foreign import javascript unsafe "(($1_1, $1_2) => { return h$decodeUtf8z($1_1,$1_2); })" js_unsafeUnpackJSStringUtf8## :: Addr# -> JSVal# ===================================== libraries/base/base.cabal ===================================== @@ -475,6 +475,7 @@ Library GHC.JS.Prim GHC.JS.Prim.Internal GHC.JS.Prim.Internal.Build + GHC.JS.Foreign.Callback -- We need to set the unit id to base (without a version number) -- as it's magic. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/88cd4bba5bd839025f00cdd2a0a574cd52dadb2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/88cd4bba5bd839025f00cdd2a0a574cd52dadb2e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 17:12:15 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 08 Mar 2023 12:12:15 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/expand-do Message-ID: <6408c1ef991d9_2c78e9217b3df851625d@gitlab.mail> Apoorv Ingle pushed new branch wip/expand-do at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/expand-do You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 20:02:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Mar 2023 15:02:55 -0500 Subject: [Git][ghc/ghc][master] 48 commits: rts: Drop redundant prototype Message-ID: <6408e9ef88e12_2c78e9245ea2d0533323@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - hadrian/src/Flavour.hs - libraries/ghc-heap/tests/all.T - rts/Capability.c - rts/Capability.h - rts/PrimOps.cmm - rts/RtsStartup.c - rts/RtsUtils.h - rts/Schedule.c - rts/Sparks.h - rts/ThreadLabels.c - rts/include/rts/storage/GC.h - rts/include/rts/storage/MBlock.h - rts/rts.cabal.in - rts/sm/BlockAlloc.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GC.h - rts/sm/GCUtils.c - rts/sm/GCUtils.h - rts/sm/HeapAlloc.h - rts/sm/MarkWeak.c - rts/sm/NonMoving.c - rts/sm/NonMoving.h - + rts/sm/NonMovingAllocate.c - + rts/sm/NonMovingAllocate.h - rts/sm/NonMovingCensus.c - rts/sm/NonMovingCensus.h - rts/sm/NonMovingMark.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bed3a292df532935426987e1f0c5eaa4f605407e...ba73a807edbb444c49e0cf21ab2ce89226a77f2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bed3a292df532935426987e1f0c5eaa4f605407e...ba73a807edbb444c49e0cf21ab2ce89226a77f2e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 20:03:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 08 Mar 2023 15:03:28 -0500 Subject: [Git][ghc/ghc][master] hadrian: Fix flavour compiler stage options off-by-one error Message-ID: <6408ea10c8d1d_2c78e92467c3ec5423a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - 9 changed files: - hadrian/doc/user-settings.md - hadrian/src/Expression.hs - hadrian/src/Flavour.hs - hadrian/src/Oracles/Flavour.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Quick.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== hadrian/doc/user-settings.md ===================================== @@ -227,17 +227,21 @@ prefixes, and `*` matches an entire path component, excluding any separators. What was previously achieved by having `GhcDebugged=YES` in `mk/build.mk` can be done by defining a custom flavour in the user settings file, one that -sets the `ghcDebugged` field of `Flavour` to `True`, e.g: +sets the `ghcDebugged` field of `Flavour` to `const True`, e.g: ``` haskell quickDebug :: Flavour -quickDebug = quickFlavour { name = "dbg", ghcDebugged = True } +quickDebug = quickFlavour { name = "dbg", ghcDebugged = const True } ``` Running `build --flavour=dbg` will build a `quick`-flavoured GHC and link GHC, iserv, iserv-proxy and remote-iserv against the debugged RTS, by passing `-debug` to the commands that link those executables. +More generally, a predicate on `Stage` can be provided to specify which stages should be built debugged. For example, setting `ghcDebugged = (>= Stage2)` will build a debugged compiler at stage 2 or higher, but not stage 1. + +Finally, the `debug_ghc` and `debug_stage1_ghc` [flavour transformers](#flavour-transformers) provide a convenient way to enable `ghcDebugged` on the command line without the need to define a separate custom flavour. + ### Packages Users can add and remove packages from particular build stages. As an example, ===================================== hadrian/src/Expression.hs ===================================== @@ -8,7 +8,8 @@ module Expression ( expr, exprIO, arg, remove, cabalFlag, -- ** Predicates - (?), stage, stage0, stage1, stage2, notStage0, threadedBootstrapper, + (?), stage, stage0, stage1, stage2, notStage0, buildingCompilerStage, + buildingCompilerStage', threadedBootstrapper, package, notPackage, packageOneOf, cross, notCross, libraryPackage, builder, way, input, inputs, output, outputs, @@ -128,6 +129,16 @@ stage2 = stage Stage2 notStage0 :: Predicate notStage0 = notM Expression.stage0 +-- | Are we currently building a compiler for a particular stage? +buildingCompilerStage :: Stage -> Predicate +buildingCompilerStage s = buildingCompilerStage' (== s) + +-- | Like 'buildingCompilerStage', but lifts an arbitrary predicate on 'Stage', +-- which is useful for checking flavour fields like 'ghcProfiled' and +-- 'ghcDebugged'. +buildingCompilerStage' :: (Stage -> Bool) -> Predicate +buildingCompilerStage' f = f . succStage <$> getStage + -- | Whether or not the bootstrapping compiler provides a threaded RTS. We need -- to know this when building stage 1, since stage 1 links against the ===================================== hadrian/src/Flavour.hs ===================================== @@ -59,8 +59,8 @@ flavourTransformers = M.fromList , "fully_static" =: fullyStatic , "collect_timings" =: collectTimings , "assertions" =: enableAssertions - , "debug_ghc" =: debugGhc Stage1 - , "debug_stage1_ghc" =: debugGhc stage0InTree + , "debug_ghc" =: debugGhc Stage2 + , "debug_stage1_ghc" =: debugGhc Stage1 , "lint" =: enableLinting , "haddock" =: enableHaddock , "hi_core" =: enableHiCore @@ -215,18 +215,29 @@ enableThreadSanitizer = addArgs $ notStage0 ? mconcat viaLlvmBackend :: Flavour -> Flavour viaLlvmBackend = addArgs $ notStage0 ? builder Ghc ? arg "-fllvm" --- | Build the GHC executable with profiling enabled in stages 1 and later. It +-- | Build the GHC executable with profiling enabled in stages 2 and later. It -- is also recommended that you use this with @'dynamicGhcPrograms' = False@ -- since GHC does not support loading of profiled libraries with the -- dynamically-linker. enableProfiledGhc :: Flavour -> Flavour enableProfiledGhc flavour = - enableLateCCS flavour { rtsWays = do - ws <- rtsWays flavour - pure $ (Set.map (\w -> if wayUnit Dynamic w then w else w <> profiling) ws) <> ws - , libraryWays = (Set.singleton profiling <>) <$> (libraryWays flavour) - , ghcProfiled = (>= Stage1) - } + enableLateCCS flavour + { rtsWays = do + ws <- rtsWays flavour + mconcat + [ pure ws + , buildingCompilerStage' (>= Stage2) ? pure (foldMap profiled_ways ws) + ] + , libraryWays = mconcat + [ libraryWays flavour + , buildingCompilerStage' (>= Stage2) ? pure (Set.singleton profiling) + ] + , ghcProfiled = (>= Stage2) + } + where + profiled_ways w + | wayUnit Dynamic w = Set.empty + | otherwise = Set.singleton (w <> profiling) -- | Disable 'dynamicGhcPrograms'. disableDynamicGhcPrograms :: Flavour -> Flavour @@ -350,11 +361,14 @@ collectTimings = -- | Build ghc with debug rts (i.e. -debug) in and after this stage debugGhc :: Stage -> Flavour -> Flavour -debugGhc stage f = f - { ghcDebugged = (>= stage) +debugGhc ghcStage f = f + { ghcDebugged = (>= ghcStage) , rtsWays = do ws <- rtsWays f - pure $ (Set.map (\w -> w <> debug) ws) <> ws + mconcat + [ pure ws + , buildingCompilerStage' (>= ghcStage) ? pure (Set.map (<> debug) ws) + ] } -- * CLI and /hadrian.settings options ===================================== hadrian/src/Oracles/Flavour.hs ===================================== @@ -24,7 +24,8 @@ type instance RuleResult GhcProfiled = Bool oracles :: Rules () oracles = do void $ addOracle $ \(DynGhcPrograms _) -> dynamicGhcPrograms =<< flavour - void $ addOracle $ \(GhcProfiled stage) -> ghcProfiled <$> flavour <*> pure stage + void $ addOracle $ \(GhcProfiled stage) -> + ghcProfiled <$> flavour <*> pure (succStage stage) askDynGhcPrograms :: Action Bool askDynGhcPrograms = askOracle $ DynGhcPrograms () ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -116,7 +116,7 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do useSystemFfi <- expr (flag UseSystemFfi) buildPath <- getBuildPath libffiName' <- libffiName - debugged <- ghcDebugged <$> expr flavour <*> getStage + debugged <- buildingCompilerStage' . ghcDebugged =<< expr flavour osxTarget <- expr isOsxTarget winTarget <- expr isWinTarget ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -101,8 +101,10 @@ inTreeCompilerArgs stg = do unregisterised <- flag GhcUnregisterised tables_next_to_code <- flag TablesNextToCode targetWithSMP <- targetSupportsSMP - debugAssertions <- ($ succStage stg) . ghcDebugAssertions <$> flavour - profiled <- ghcProfiled <$> flavour <*> pure stg + + let ghcStage = succStage stg + debugAssertions <- ghcDebugAssertions <$> flavour <*> pure ghcStage + profiled <- ghcProfiled <$> flavour <*> pure ghcStage os <- setting HostOs arch <- setting TargetArch ===================================== hadrian/src/Settings/Flavours/Development.hs ===================================== @@ -24,8 +24,7 @@ developmentFlavour ghcStage = defaultFlavour stageString s = error ("developmentFlavour not supported for " ++ show s) developmentArgs :: Stage -> Args -developmentArgs ghcStage = do - stage <- getStage +developmentArgs ghcStage = sourceArgs SourceArgs { hsDefault = mconcat [ pure ["-O", "-H64m"], -- Disable optimization when building Cabal; @@ -33,5 +32,5 @@ developmentArgs ghcStage = do package cabal ? pure ["-O0"]] , hsLibrary = notStage0 ? arg "-dlint" , hsCompiler = mconcat [stage0 ? arg "-O2", - stage == predStage ghcStage ? pure ["-O0"]] - , hsGhc = stage == predStage ghcStage ? pure ["-O0"] } + buildingCompilerStage ghcStage ? pure ["-O0"]] + , hsGhc = buildingCompilerStage ghcStage ? pure ["-O0"] } ===================================== hadrian/src/Settings/Flavours/Quick.hs ===================================== @@ -42,5 +42,5 @@ quickArgs = sourceArgs SourceArgs quickDebugFlavour :: Flavour quickDebugFlavour = quickFlavour { name = "quick-debug" - , ghcDebugged = (>= Stage1) + , ghcDebugged = (>= Stage2) } ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -6,7 +6,6 @@ import Oracles.Setting import Oracles.Flag import Packages import Settings -import Oracles.Flavour -- | Package-specific command-line arguments. packageArgs :: Args @@ -24,14 +23,12 @@ packageArgs = do -- are building. This is used to build cross-compilers bootCross = (==) <$> ghcVersionStage (stage0InTree) <*> ghcVersionStage Stage1 + compilerStageOption f = buildingCompilerStage' . f =<< expr flavour + cursesIncludeDir <- getSetting CursesIncludeDir cursesLibraryDir <- getSetting CursesLibDir ffiIncludeDir <- getSetting FfiIncludeDir ffiLibraryDir <- getSetting FfiLibDir - debugAssertions <- ( `ghcDebugAssertions` (succStage stage) ) <$> expr flavour - -- NB: in this function, "stage" is the stage of the compiler we are - -- using to build, but ghcDebugAssertions wants the stage of the compiler - -- we are building, which we get using succStage. mconcat --------------------------------- base --------------------------------- @@ -54,7 +51,7 @@ packageArgs = do [ builder Alex ? arg "--latin1" , builder (Ghc CompileHs) ? mconcat - [ debugAssertions ? arg "-DDEBUG" + [ compilerStageOption ghcDebugAssertions ? arg "-DDEBUG" , inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto" , input "**/Parser.hs" ? @@ -71,7 +68,7 @@ packageArgs = do , builder (Cabal Setup) ? mconcat [ arg "--disable-library-for-ghci" , anyTargetOs ["openbsd"] ? arg "--ld-options=-E" - , (getStage >>= expr . askGhcProfiled) ? arg "--ghc-pkg-option=--force" ] + , compilerStageOption ghcProfiled ? arg "--ghc-pkg-option=--force" ] , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" @@ -85,7 +82,7 @@ packageArgs = do , package ghc ? mconcat [ builder Ghc ? mconcat [ arg ("-I" ++ compilerPath) - , debugAssertions ? arg "-DDEBUG" ] + , compilerStageOption ghcDebugAssertions ? arg "-DDEBUG" ] , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" @@ -96,7 +93,7 @@ packageArgs = do -- We build a threaded stage N, N>1 if the configuration calls -- for it. - ((ghcThreaded <$> expr flavour <*> getStage ) `cabalFlag` "threaded") + (compilerStageOption ghcThreaded `cabalFlag` "threaded") ] ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c813d0688f03c782d3c3a93a8369a48b7e74c8d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c813d0688f03c782d3c3a93a8369a48b7e74c8d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 20:07:09 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Wed, 08 Mar 2023 15:07:09 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/supersven/StgRetBCO-struct Message-ID: <6408eaed474eb_2c78e924a9eee8543050@gitlab.mail> Sven Tennie pushed new branch wip/supersven/StgRetBCO-struct at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/supersven/StgRetBCO-struct You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 20:16:39 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Wed, 08 Mar 2023 15:16:39 -0500 Subject: [Git][ghc/ghc][wip/supersven/StgRetBCO-struct] Use closure size instead of addresses Message-ID: <6408ed27f2434_2c78e924d75ef0545231@gitlab.mail> Sven Tennie pushed to branch wip/supersven/StgRetBCO-struct at Glasgow Haskell Compiler / GHC Commits: f8f1a6a0 by Sven Tennie at 2023-03-08T20:15:56+00:00 Use closure size instead of addresses - - - - - 1 changed file: - rts/sm/Scav.c Changes: ===================================== rts/sm/Scav.c ===================================== @@ -1986,11 +1986,11 @@ scavenge_stack(StgPtr p, StgPtr stack_end) StgRetBCO* retBCO; StgWord size; - retBCO = (StgRetBCO*) p; - evacuate((StgClosure **)&retBCO->bco); + retBCO = (StgRetBCO *) p; + evacuate((StgClosure **) &retBCO->bco); size = BCO_BITMAP_SIZE(retBCO->bco); scavenge_large_bitmap((StgPtr) &retBCO->args, BCO_BITMAP(retBCO->bco), size); - p = retBCO->args + size; + p += sizeofW(StgRetBCO) + size; continue; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8f1a6a0d9cda2acc485c9b5a4b404b0e5349c49 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8f1a6a0d9cda2acc485c9b5a4b404b0e5349c49 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 21:10:32 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 08 Mar 2023 16:10:32 -0500 Subject: [Git][ghc/ghc][wip/T19627] 50 commits: rts: Drop redundant prototype Message-ID: <6408f9c85cfd4_2c78e925e66458547654@gitlab.mail> Apoorv Ingle pushed to branch wip/T19627 at Glasgow Haskell Compiler / GHC Commits: 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - 61e58ea3 by Apoorv Ingle at 2023-03-08T21:10:28+00:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Tc/Solver.hs - hadrian/doc/user-settings.md - hadrian/src/Expression.hs - hadrian/src/Flavour.hs - hadrian/src/Oracles/Flavour.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Quick.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-heap/tests/all.T - rts/Capability.c - rts/Capability.h - rts/PrimOps.cmm - rts/RtsStartup.c - rts/RtsUtils.h - rts/Schedule.c - rts/Sparks.h - rts/ThreadLabels.c - rts/include/rts/storage/GC.h - rts/include/rts/storage/MBlock.h - rts/rts.cabal.in - rts/sm/BlockAlloc.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GC.h - rts/sm/GCUtils.c - rts/sm/GCUtils.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a470a0e41ac9498f08261e9979888e3026313f25...61e58ea3bdceff3c7aa13eecb23f25b619e2ad02 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a470a0e41ac9498f08261e9979888e3026313f25...61e58ea3bdceff3c7aa13eecb23f25b619e2ad02 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 23:40:15 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 08 Mar 2023 18:40:15 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T23030 Message-ID: <64091cdfa85f5_2c78e9286c9e0455937@gitlab.mail> Ben Gamari pushed new branch wip/T23030 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23030 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 8 23:46:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 08 Mar 2023 18:46:14 -0500 Subject: [Git][ghc/ghc][wip/T23030] 2 commits: nativeGen/AArch64: Fix bitmask immediate predicate Message-ID: <64091e46d8b69_2c78e9286d4ad4562919@gitlab.mail> Ben Gamari pushed to branch wip/T23030 at Glasgow Haskell Compiler / GHC Commits: 3744cff9 by Ben Gamari at 2023-03-08T18:46:08-05:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 97a2e97e by Ben Gamari at 2023-03-08T18:46:08-05:00 nativeGen/AArch64: Improve codegen for MO_Xor immediates This extends the codegen to allow MO_Xor operands to be encoded as bitmask immediates. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -773,16 +773,21 @@ getRegister' config plat expr return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) -- 3. Logic &&, || - CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isBitMaskImmediate (fromIntegral n) -> + CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (fromIntegral n) -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (AND (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) where w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) r' = getRegisterReg plat reg - CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isBitMaskImmediate (fromIntegral n) -> + CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (fromIntegral n) -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ORR (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) where w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) r' = getRegisterReg plat reg + CmmMachOp (MO_Xor w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (fromIntegral n) -> + return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (EOR (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) + where w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) + r' = getRegisterReg plat reg + -- Generic case. CmmMachOp op [x, y] -> do -- alright, so we have an operation, and two expressions. And we want to essentially do @@ -963,19 +968,6 @@ getRegister' config plat expr where isNbitEncodeable :: Int -> Integer -> Bool isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) - -- This needs to check if n can be encoded as a bitmask immediate: - -- - -- See https://stackoverflow.com/questions/30904718/range-of-immediate-values-in-armv8-a64-assembly - -- - isBitMaskImmediate :: Integer -> Bool - isBitMaskImmediate i = i `elem` [0b0000_0001, 0b0000_0010, 0b0000_0100, 0b0000_1000, 0b0001_0000, 0b0010_0000, 0b0100_0000, 0b1000_0000 - ,0b0000_0011, 0b0000_0110, 0b0000_1100, 0b0001_1000, 0b0011_0000, 0b0110_0000, 0b1100_0000 - ,0b0000_0111, 0b0000_1110, 0b0001_1100, 0b0011_1000, 0b0111_0000, 0b1110_0000 - ,0b0000_1111, 0b0001_1110, 0b0011_1100, 0b0111_1000, 0b1111_0000 - ,0b0001_1111, 0b0011_1110, 0b0111_1100, 0b1111_1000 - ,0b0011_1111, 0b0111_1110, 0b1111_1100 - ,0b0111_1111, 0b1111_1110 - ,0b1111_1111] -- N.B. MUL does not set the overflow flag. do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register @@ -1018,6 +1010,35 @@ getRegister' config plat expr CMP (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) `snocOL` CSET (OpReg w dst) NE) +-- | Is a given number encodable as a bitmask immediate? +-- +-- https://stackoverflow.com/questions/30904718/range-of-immediate-values-in-armv8-a64-assembly +isAArch64Bitmask :: Integer -> Bool +isAArch64Bitmask n = + check 64 || check 32 || check 16 || check 8 + where + -- Check whether @n@ can be represented as a subpattern of the given + -- width. + check width + | hasOneRun subpat = + let n' = fromIntegral (mkPat width subpat) + in n == n' + | otherwise = False + where + subpat :: Word64 + subpat = fromIntegral (n .&. (bit width - 1)) + + -- Construct a bit-pattern from a repeated subpatterns the given width. + mkPat :: Int -> Word64 -> Word64 + mkPat width subpat = + foldl' (.|.) 0 [ subpat `shiftL` p | p <- [0, width..63] ] + + -- Does the given number's bit representation match the regular expression + -- @0*1*0*@? + hasOneRun :: Word64 -> Bool + hasOneRun m = + 64 == popCount m + countLeadingZeros m + countTrailingZeros m + -- | Instructions to sign-extend the value in the given register from width @w@ -- up to width @w'@. signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1745cc2c00a6b102d7431143fadd040990a31be...97a2e97e67c549c4476b41a283aa0b372a51db7d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1745cc2c00a6b102d7431143fadd040990a31be...97a2e97e67c549c4476b41a283aa0b372a51db7d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 9 00:40:40 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 08 Mar 2023 19:40:40 -0500 Subject: [Git][ghc/ghc][wip/expand-do] Start of HsExpand for HsDo Fixes for #T18324 Message-ID: <64092b082be23_2c78e929bb3838565490@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 98dd17bf by Apoorv Ingle at 2023-03-08T18:40:25-06:00 Start of HsExpand for HsDo Fixes for #T18324 - - - - - 2 changed files: - compiler/GHC/Rename/Expr.hs - + testsuite/tests/rebindable/T18324.hs Changes: ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -433,7 +433,10 @@ rnExpr (HsDo _ do_or_lc (L l stmts)) rnStmtsWithFreeVars (HsDoStmt do_or_lc) rnExpr stmts (\ _ -> return ((), emptyFVs)) ; (pp_stmts, fvs2) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 - ; return ( HsDo noExtField do_or_lc (L l pp_stmts), fvs1 `plusFV` fvs2 ) } + ; let orig_do_block = HsDo noExtField do_or_lc (L l pp_stmts) + expd_do_block = expand_do_stmts pp_stmts + ; return ( mkExpandedExpr orig_do_block expd_do_block + , fvs1 `plusFV` fvs2 ) } -- ExplicitList: see Note [Handling overloaded and rebindable constructs] rnExpr (ExplicitList _ exps) @@ -1165,7 +1168,7 @@ rnStmt ctxt rnBody (L loc (LastStmt _ (L lb body) noret _)) thing_inside else return (noSyntaxExpr, emptyFVs) -- The 'return' in a LastStmt is used only -- for MonadComp; and we don't want to report - -- "non in scope: return" in other cases + -- "not in scope: return" in other cases -- #15607 ; (thing, fvs3) <- thing_inside [] @@ -2703,6 +2706,53 @@ mkExpandedExpr -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedExpr a b = XExpr (HsExpanded a b) + + +-- | Expand the Do statments so that it works fine with Quicklook +-- See Note[Rebindable Do Expanding Statements] +expand_do_stmts :: [ExprLStmt GhcRn] -> HsExpr GhcRn + +expand_do_stmts [L _ (LastStmt _ body _ NoSyntaxExprRn)] +-- TODO: not sure about this maybe this never happens in a do block? +-- This does happen in a list comprehension though +-- = genHsApp (genHsVar returnMName) body + = unLoc body + +expand_do_stmts [L l (LastStmt _ body _ (SyntaxExprRn ret))] +-- +-- ------------------------------------------------ +-- return e ~~> return e +-- definitely works T18324.hs + = unLoc $ mkHsApp (L l ret) body + +expand_do_stmts ((L l (BindStmt _ x e)):lstmts) +-- stmts ~~> stmt' +-- ------------------------------------------------ +-- x <- e ; stmts ~~> (Prelude.>>=) e (\ x -> stmts' ) + = genHsApps bindMName -- (>>=) + [ e -- e + , mkHsLam [x] (L l $ expand_do_stmts lstmts) -- (\ x -> stmts') + ] +-- expand_do_stmts ((L l (LetStmt _ x e)):lstmts) = undefined +-- stmts ~~> stmts' +-- ------------------------------------------------ +-- let x = e ; stmts ~~> let x = e in stmts' + +expand_do_stmts ((L l (BodyStmt _ e (SyntaxExprRn f) _)):lstmts) +-- stmts ~~> stmts' +-- ---------------------------------------------- +-- e ; stmts ~~> (Prelude.>>) e (\ _ -> stmt') + = unLoc $ nlHsApp (nlHsApp (L l f) -- (>>) See Note [BodyStmt] + e + ) + $ mkHsLam [] (L l $ expand_do_stmts lstmts) + +-- expand_do_stmts ((L l (TransStmt {})):lstmts) = undefined +-- expand_do_stmts ((L l (RecStmt {})):lstmts) = undefined + +-- expand_do_stmts (stmt@(L _ (ParStmt {})):_) = pprPanic "expand_do_stmts: impossible happened" $ ppr stmt +expand_do_stmts stmt = pprPanic "expand_do_stmts: impossible happened" $ ppr stmt + ----------------------------------------- -- Bits and pieces for RecordDotSyntax. -- ===================================== testsuite/tests/rebindable/T18324.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE ImpredicativeTypes, DeriveAnyClass #-} +module T18324 where + + +type Id = forall a. a -> a + +t :: IO Id +t = return id + +p :: Id -> (Bool, Int) +p f = (f True, f 3) + +foo1 = t >>= \x -> return (p x) + +foo2 = do { x <- t ; return (p x) } + + +-- data State a s = S (a, s) deriving (Functor, Applicative, Monad) + +-- update :: State a s -> (s -> s) -> State a s +-- update (S (a, s)) f = S (a, f s) + + +-- ts :: State Int Id +-- ts = return id + +-- foo3 = do { x <- ts ; update ts ; return (p x) } + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98dd17bf9936958658daacccb4ec64f62fe36f67 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98dd17bf9936958658daacccb4ec64f62fe36f67 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 9 00:41:37 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 08 Mar 2023 19:41:37 -0500 Subject: [Git][ghc/ghc][wip/expand-do] Start of HsExpand for HsDo Fixes for #18324 Message-ID: <64092b4165048_2c78e929c0ceb05656b8@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: c4aadb28 by Apoorv Ingle at 2023-03-08T18:41:26-06:00 Start of HsExpand for HsDo Fixes for #18324 - - - - - 2 changed files: - compiler/GHC/Rename/Expr.hs - + testsuite/tests/rebindable/T18324.hs Changes: ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -433,7 +433,10 @@ rnExpr (HsDo _ do_or_lc (L l stmts)) rnStmtsWithFreeVars (HsDoStmt do_or_lc) rnExpr stmts (\ _ -> return ((), emptyFVs)) ; (pp_stmts, fvs2) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 - ; return ( HsDo noExtField do_or_lc (L l pp_stmts), fvs1 `plusFV` fvs2 ) } + ; let orig_do_block = HsDo noExtField do_or_lc (L l pp_stmts) + expd_do_block = expand_do_stmts pp_stmts + ; return ( mkExpandedExpr orig_do_block expd_do_block + , fvs1 `plusFV` fvs2 ) } -- ExplicitList: see Note [Handling overloaded and rebindable constructs] rnExpr (ExplicitList _ exps) @@ -1165,7 +1168,7 @@ rnStmt ctxt rnBody (L loc (LastStmt _ (L lb body) noret _)) thing_inside else return (noSyntaxExpr, emptyFVs) -- The 'return' in a LastStmt is used only -- for MonadComp; and we don't want to report - -- "non in scope: return" in other cases + -- "not in scope: return" in other cases -- #15607 ; (thing, fvs3) <- thing_inside [] @@ -2703,6 +2706,53 @@ mkExpandedExpr -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedExpr a b = XExpr (HsExpanded a b) + + +-- | Expand the Do statments so that it works fine with Quicklook +-- See Note[Rebindable Do Expanding Statements] +expand_do_stmts :: [ExprLStmt GhcRn] -> HsExpr GhcRn + +expand_do_stmts [L _ (LastStmt _ body _ NoSyntaxExprRn)] +-- TODO: not sure about this maybe this never happens in a do block? +-- This does happen in a list comprehension though +-- = genHsApp (genHsVar returnMName) body + = unLoc body + +expand_do_stmts [L l (LastStmt _ body _ (SyntaxExprRn ret))] +-- +-- ------------------------------------------------ +-- return e ~~> return e +-- definitely works T18324.hs + = unLoc $ mkHsApp (L l ret) body + +expand_do_stmts ((L l (BindStmt _ x e)):lstmts) +-- stmts ~~> stmt' +-- ------------------------------------------------ +-- x <- e ; stmts ~~> (Prelude.>>=) e (\ x -> stmts' ) + = genHsApps bindMName -- (>>=) + [ e -- e + , mkHsLam [x] (L l $ expand_do_stmts lstmts) -- (\ x -> stmts') + ] +-- expand_do_stmts ((L l (LetStmt _ x e)):lstmts) = undefined +-- stmts ~~> stmts' +-- ------------------------------------------------ +-- let x = e ; stmts ~~> let x = e in stmts' + +expand_do_stmts ((L l (BodyStmt _ e (SyntaxExprRn f) _)):lstmts) +-- stmts ~~> stmts' +-- ---------------------------------------------- +-- e ; stmts ~~> (Prelude.>>) e (\ _ -> stmt') + = unLoc $ nlHsApp (nlHsApp (L l f) -- (>>) See Note [BodyStmt] + e + ) + $ mkHsLam [] (L l $ expand_do_stmts lstmts) + +-- expand_do_stmts ((L l (TransStmt {})):lstmts) = undefined +-- expand_do_stmts ((L l (RecStmt {})):lstmts) = undefined + +-- expand_do_stmts (stmt@(L _ (ParStmt {})):_) = pprPanic "expand_do_stmts: impossible happened" $ ppr stmt +expand_do_stmts stmt = pprPanic "expand_do_stmts: impossible happened" $ ppr stmt + ----------------------------------------- -- Bits and pieces for RecordDotSyntax. -- ===================================== testsuite/tests/rebindable/T18324.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE ImpredicativeTypes, DeriveAnyClass #-} +module T18324 where + + +type Id = forall a. a -> a + +t :: IO Id +t = return id + +p :: Id -> (Bool, Int) +p f = (f True, f 3) + +foo1 = t >>= \x -> return (p x) + +foo2 = do { x <- t ; return (p x) } + + +-- data State a s = S (a, s) deriving (Functor, Applicative, Monad) + +-- update :: State a s -> (s -> s) -> State a s +-- update (S (a, s)) f = S (a, f s) + + +-- ts :: State Int Id +-- ts = return id + +-- foo3 = do { x <- ts ; update ts ; return (p x) } + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4aadb286a407e5af13657d5b970501196ac338f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4aadb286a407e5af13657d5b970501196ac338f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 9 11:28:24 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 09 Mar 2023 06:28:24 -0500 Subject: [Git][ghc/ghc][wip/ghc-with-debug] Add support for ghc-debug to ghc executable Message-ID: <6409c2d8dea77_2c78e933e5dd7c617228@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-with-debug at Glasgow Haskell Compiler / GHC Commits: 325c124e by Matthew Pickering at 2023-03-09T11:28:14+00:00 Add support for ghc-debug to ghc executable - - - - - 8 changed files: - .gitmodules - + ghc-debug - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - + instructions.md Changes: ===================================== .gitmodules ===================================== @@ -113,3 +113,6 @@ [submodule "utils/hpc"] path = utils/hpc url = https://gitlab.haskell.org/hpc/hpc-bin.git +[submodule "ghc-debug"] + path = ghc-debug + url = git at gitlab.haskell.org:ghc/ghc-debug.git ===================================== ghc-debug ===================================== @@ -0,0 +1 @@ +Subproject commit 537e462a5c987537725d95caa10fa6d7b30abf37 ===================================== ghc/Main.hs ===================================== @@ -32,6 +32,7 @@ import GHC.Driver.Backpack ( doBackpack ) import GHC.Driver.Plugins import GHC.Driver.Config.Logger (initLogFlags) import GHC.Driver.Config.Diagnostic +import GHC.Driver.Monad import GHC.Platform import GHC.Platform.Ways @@ -99,6 +100,10 @@ import Data.Bifunctor import GHC.Data.Graph.Directed import qualified Data.List.NonEmpty as NE +#if defined(GHC_DEBUG) +import GHC.Debug.Stub +#endif + ----------------------------------------------------------------------------- -- ToDo: @@ -111,6 +116,13 @@ import qualified Data.List.NonEmpty as NE ----------------------------------------------------------------------------- -- GHC's command-line interface +debugWrapper :: IO a -> IO a +#if defined(GHC_DEBUG) +debugWrapper = withGhcDebug +#else +debugWrapper = id +#endif + main :: IO () main = do hSetBuffering stdout LineBuffering @@ -159,8 +171,10 @@ main = do ShowGhcUsage -> showGhcUsage dflags ShowGhciUsage -> showGhciUsage dflags PrintWithDynFlags f -> putStrLn (f dflags) - Right postLoadMode -> - main' postLoadMode units dflags argv3 flagWarnings + Right postLoadMode -> do + reifyGhc $ \session -> debugWrapper $ + reflectGhc (main' postLoadMode units dflags argv3 flagWarnings) session + main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn] -> Ghc () ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -22,6 +22,11 @@ Flag internal-interpreter Default: False Manual: True +Flag ghc-debug + Description: Build with support for ghc-debug. + Default: False + Manual: True + Flag threaded Description: Link the ghc executable against the threaded RTS Default: True @@ -42,6 +47,10 @@ Executable ghc ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ + if flag(ghc-debug) + build-depends: ghc-debug-stub + CPP-OPTIONS: -DGHC_DEBUG + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.14 else ===================================== hadrian/src/Packages.hs ===================================== @@ -11,7 +11,7 @@ module Packages ( runGhc, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, - ghcPackages, isGhcPackage, + ghcPackages, isGhcPackage, ghc_debug_convention, ghc_debug_stub, -- * Package information crossPrefix, programName, nonHsMainPackage, autogenPath, programPath, timeoutPath, @@ -43,7 +43,9 @@ ghcPackages = , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon - , lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] + , lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace + , ghc_debug_convention + , ghc_debug_stub ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -122,6 +124,8 @@ unlit = util "unlit" unix = lib "unix" win32 = lib "Win32" xhtml = lib "xhtml" +ghc_debug_convention = lib "ghc-debug-convention" `setPath` "ghc-debug/convention" +ghc_debug_stub = lib "ghc-debug-stub" `setPath` "ghc-debug/stub" lintersCommon = lib "linters-common" `setPath` "linters/linters-common" lintNotes = linter "lint-notes" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -146,6 +146,8 @@ stage1Packages = do , unlit , xhtml , if winTarget then win32 else unix + , ghc_debug_convention + , ghc_debug_stub ] , when (not cross) [ haddock ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -89,6 +89,7 @@ packageArgs = do , builder (Cabal Flags) ? mconcat [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" + , notStage0 `cabalFlag` "ghc-debug" , ifM stage0 -- We build a threaded stage 1 if the bootstrapping compiler -- supports it. ===================================== instructions.md ===================================== @@ -0,0 +1,45 @@ +# Building GHC + +* Add the following to _build/hadrian.settings + +``` +stage1.*.ghc.hs.opts += -finfo-table-map -fdistinct-constructor-tables +``` + +* Build GHC as normal + +``` +./hadrian/build -j8 +``` + +* The result is a ghc-debug enabled compiler + +# Building a debugger + +* Use the compiler you just built to build ghc-debug + +``` +cd ghc-debug +cabal update +cabal new-build debugger -w ../_build/stage1/bin/ghc +``` + +# Running the debugger + +Modify `test/Test.hs` to implement the debugging thing you want to do. Perhaps +start with `p30`, which is a program to generate a profile. + + +* Start the process you want to debug +``` +GHC_DEBUG_SOCKET=/tmp/ghc-debug build-cabal +``` + +* Start the debugger +``` +cabal new-run debugger -w ... +``` + +* Open a ticket about the memory issue you find. + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/325c124eb817b157476b305265a0f8361df92d3d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/325c124eb817b157476b305265a0f8361df92d3d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 9 12:12:06 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 09 Mar 2023 07:12:06 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 51 commits: rts: Drop redundant prototype Message-ID: <6409cd1672fa7_2c78e934cf847c625667@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - 4f10bca4 by Luite Stegeman at 2023-03-09T07:12:00-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - ce9e4e73 by Apoorv Ingle at 2023-03-09T07:12:00-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Linker/Static.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Utils/TmpFs.hs - hadrian/doc/user-settings.md - hadrian/src/Expression.hs - hadrian/src/Flavour.hs - hadrian/src/Oracles/Flavour.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Quick.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-heap/tests/all.T - rts/Capability.c - rts/Capability.h - rts/PrimOps.cmm - rts/RtsStartup.c - rts/RtsUtils.h - rts/Schedule.c - rts/Sparks.h - rts/ThreadLabels.c - rts/include/rts/storage/GC.h - rts/include/rts/storage/MBlock.h - rts/rts.cabal.in - rts/sm/BlockAlloc.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GC.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d2efa2cc0476f73ba04e9fa45907a59ebe7a6d7...ce9e4e731952339cd9a1a52681bc838fb8778edc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d2efa2cc0476f73ba04e9fa45907a59ebe7a6d7...ce9e4e731952339cd9a1a52681bc838fb8778edc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 9 14:35:51 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 09 Mar 2023 09:35:51 -0500 Subject: [Git][ghc/ghc][wip/T23030] Deleted 1 commit: nativeGen/AArch64: Improve codegen for MO_Xor immediates Message-ID: <6409eec7f4211_2c78e93743353c66656a@gitlab.mail> Ben Gamari pushed to branch wip/T23030 at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: 97a2e97e by Ben Gamari at 2023-03-08T18:46:08-05:00 nativeGen/AArch64: Improve codegen for MO_Xor immediates This extends the codegen to allow MO_Xor operands to be encoded as bitmask immediates. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -783,6 +783,11 @@ getRegister' config plat expr where w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) r' = getRegisterReg plat reg + CmmMachOp (MO_Xor w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (fromIntegral n) -> + return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (EOR (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) + where w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) + r' = getRegisterReg plat reg + -- Generic case. CmmMachOp op [x, y] -> do -- alright, so we have an operation, and two expressions. And we want to essentially do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/97a2e97e67c549c4476b41a283aa0b372a51db7d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/97a2e97e67c549c4476b41a283aa0b372a51db7d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 9 14:47:00 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 09 Mar 2023 09:47:00 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T23096 Message-ID: <6409f164d6e70_2c78e9375f0208668560@gitlab.mail> Ben Gamari pushed new branch wip/T23096 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23096 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 9 14:52:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 09 Mar 2023 09:52:27 -0500 Subject: [Git][ghc/ghc][master] Delete created temporary subdirectories at end of session. Message-ID: <6409f2abfe0d_2c78e937b1a47c6735c9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 2 changed files: - compiler/GHC/Linker/Static.hs - compiler/GHC/Utils/TmpFs.hs Changes: ===================================== compiler/GHC/Linker/Static.hs ===================================== @@ -126,7 +126,7 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do if gopt Opt_SingleLibFolder dflags then do libs <- getLibs namever ways_ unit_env dep_units - tmpDir <- newTempDir logger tmpfs (tmpDir dflags) + tmpDir <- newTempSubDir logger tmpfs (tmpDir dflags) sequence_ [ copyFile lib (tmpDir basename) | (lib, basename) <- libs] return [ "-L" ++ tmpDir ] ===================================== compiler/GHC/Utils/TmpFs.hs ===================================== @@ -6,8 +6,8 @@ module GHC.Utils.TmpFs , initTmpFs , forkTmpFsFrom , mergeTmpFsInto - , FilesToClean(..) - , emptyFilesToClean + , PathsToClean(..) + , emptyPathsToClean , TempFileLifetime(..) , TempDir (..) , cleanTempDirs @@ -17,7 +17,7 @@ module GHC.Utils.TmpFs , changeTempFilesLifetime , newTempName , newTempLibName - , newTempDir + , newTempSubDir , withSystemTempDirectory , withTempDirectory ) @@ -63,25 +63,29 @@ data TmpFs = TmpFs -- -- Shared with forked TmpFs. - , tmp_files_to_clean :: IORef FilesToClean + , tmp_files_to_clean :: IORef PathsToClean -- ^ Files to clean (per session or per module) -- -- Not shared with forked TmpFs. + , tmp_subdirs_to_clean :: IORef PathsToClean + -- ^ Subdirs to clean (per session or per module) + -- + -- Not shared with forked TmpFs. } --- | A collection of files that must be deleted before ghc exits. -data FilesToClean = FilesToClean - { ftcGhcSession :: !(Set FilePath) - -- ^ Files that will be deleted at the end of runGhc(T) +-- | A collection of paths that must be deleted before ghc exits. +data PathsToClean = PathsToClean + { ptcGhcSession :: !(Set FilePath) + -- ^ Paths that will be deleted at the end of runGhc(T) - , ftcCurrentModule :: !(Set FilePath) - -- ^ Files that will be deleted the next time + , ptcCurrentModule :: !(Set FilePath) + -- ^ Paths that will be deleted the next time -- 'cleanCurrentModuleTempFiles' is called, or otherwise at the end of -- the session. } -- | Used when a temp file is created. This determines which component Set of --- FilesToClean will get the temp file +-- PathsToClean will get the temp file data TempFileLifetime = TFL_CurrentModule -- ^ A file with lifetime TFL_CurrentModule will be cleaned up at the @@ -93,38 +97,45 @@ data TempFileLifetime newtype TempDir = TempDir FilePath --- | An empty FilesToClean -emptyFilesToClean :: FilesToClean -emptyFilesToClean = FilesToClean Set.empty Set.empty +-- | An empty PathsToClean +emptyPathsToClean :: PathsToClean +emptyPathsToClean = PathsToClean Set.empty Set.empty --- | Merge two FilesToClean -mergeFilesToClean :: FilesToClean -> FilesToClean -> FilesToClean -mergeFilesToClean x y = FilesToClean - { ftcGhcSession = Set.union (ftcGhcSession x) (ftcGhcSession y) - , ftcCurrentModule = Set.union (ftcCurrentModule x) (ftcCurrentModule y) +-- | Merge two PathsToClean +mergePathsToClean :: PathsToClean -> PathsToClean -> PathsToClean +mergePathsToClean x y = PathsToClean + { ptcGhcSession = Set.union (ptcGhcSession x) (ptcGhcSession y) + , ptcCurrentModule = Set.union (ptcCurrentModule x) (ptcCurrentModule y) } -- | Initialise an empty TmpFs initTmpFs :: IO TmpFs initTmpFs = do - files <- newIORef emptyFilesToClean - dirs <- newIORef Map.empty - next <- newIORef 0 + files <- newIORef emptyPathsToClean + subdirs <- newIORef emptyPathsToClean + dirs <- newIORef Map.empty + next <- newIORef 0 return $ TmpFs - { tmp_files_to_clean = files - , tmp_dirs_to_clean = dirs - , tmp_next_suffix = next + { tmp_files_to_clean = files + , tmp_subdirs_to_clean = subdirs + , tmp_dirs_to_clean = dirs + , tmp_next_suffix = next } -- | Initialise an empty TmpFs sharing unique numbers and per-process temporary -- directories with the given TmpFs +-- +-- It's not safe to use the subdirs created by the original TmpFs with the +-- forked one. Use @newTempSubDir@ to create new subdirs instead. forkTmpFsFrom :: TmpFs -> IO TmpFs forkTmpFsFrom old = do - files <- newIORef emptyFilesToClean + files <- newIORef emptyPathsToClean + subdirs <- newIORef emptyPathsToClean return $ TmpFs - { tmp_files_to_clean = files - , tmp_dirs_to_clean = tmp_dirs_to_clean old - , tmp_next_suffix = tmp_next_suffix old + { tmp_files_to_clean = files + , tmp_subdirs_to_clean = subdirs + , tmp_dirs_to_clean = tmp_dirs_to_clean old + , tmp_next_suffix = tmp_next_suffix old } -- | Merge the first TmpFs into the second. @@ -132,8 +143,11 @@ forkTmpFsFrom old = do -- The first TmpFs is returned emptied. mergeTmpFsInto :: TmpFs -> TmpFs -> IO () mergeTmpFsInto src dst = do - src_files <- atomicModifyIORef' (tmp_files_to_clean src) (\s -> (emptyFilesToClean, s)) - atomicModifyIORef' (tmp_files_to_clean dst) (\s -> (mergeFilesToClean src_files s, ())) + src_files <- atomicModifyIORef' (tmp_files_to_clean src) (\s -> (emptyPathsToClean, s)) + src_subdirs <- atomicModifyIORef' (tmp_subdirs_to_clean src) (\s -> (emptyPathsToClean, s)) + atomicModifyIORef' (tmp_files_to_clean dst) (\s -> (mergePathsToClean src_files s, ())) + atomicModifyIORef' (tmp_subdirs_to_clean dst) (\s -> (mergePathsToClean src_subdirs s, ())) + cleanTempDirs :: Logger -> TmpFs -> IO () cleanTempDirs logger tmpfs @@ -142,64 +156,78 @@ cleanTempDirs logger tmpfs ds <- atomicModifyIORef' ref $ \ds -> (Map.empty, ds) removeTmpDirs logger (Map.elems ds) --- | Delete all files in @tmp_files_to_clean at . +-- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean at . cleanTempFiles :: Logger -> TmpFs -> IO () cleanTempFiles logger tmpfs = mask_ - $ do let ref = tmp_files_to_clean tmpfs - to_delete <- atomicModifyIORef' ref $ - \FilesToClean - { ftcCurrentModule = cm_files - , ftcGhcSession = gs_files - } -> ( emptyFilesToClean - , Set.toList cm_files ++ Set.toList gs_files) - removeTmpFiles logger to_delete - --- | Delete all files in @tmp_files_to_clean at . That have lifetime --- TFL_CurrentModule. + $ do removeWith (removeTmpFiles logger) (tmp_files_to_clean tmpfs) + removeWith (removeTmpSubdirs logger) (tmp_subdirs_to_clean tmpfs) + where + removeWith remove ref = do + to_delete <- atomicModifyIORef' ref $ + \PathsToClean + { ptcCurrentModule = cm_paths + , ptcGhcSession = gs_paths + } -> ( emptyPathsToClean + , Set.toList cm_paths ++ Set.toList gs_paths) + remove to_delete + +-- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@ +-- That have lifetime TFL_CurrentModule. -- If a file must be cleaned eventually, but must survive a -- cleanCurrentModuleTempFiles, ensure it has lifetime TFL_GhcSession. cleanCurrentModuleTempFiles :: Logger -> TmpFs -> IO () cleanCurrentModuleTempFiles logger tmpfs = mask_ - $ do let ref = tmp_files_to_clean tmpfs + $ do removeWith (removeTmpFiles logger) (tmp_files_to_clean tmpfs) + removeWith (removeTmpSubdirs logger) (tmp_subdirs_to_clean tmpfs) + where + removeWith remove ref = do to_delete <- atomicModifyIORef' ref $ - \ftc at FilesToClean{ftcCurrentModule = cm_files} -> - (ftc {ftcCurrentModule = Set.empty}, Set.toList cm_files) - removeTmpFiles logger to_delete + \ptc at PathsToClean{ptcCurrentModule = cm_paths} -> + (ptc {ptcCurrentModule = Set.empty}, Set.toList cm_paths) + remove to_delete -- | Ensure that new_files are cleaned on the next call of -- 'cleanTempFiles' or 'cleanCurrentModuleTempFiles', depending on lifetime. -- If any of new_files are already tracked, they will have their lifetime -- updated. addFilesToClean :: TmpFs -> TempFileLifetime -> [FilePath] -> IO () -addFilesToClean tmpfs lifetime new_files = modifyIORef' (tmp_files_to_clean tmpfs) $ - \FilesToClean - { ftcCurrentModule = cm_files - , ftcGhcSession = gs_files +addFilesToClean tmpfs lifetime new_files = + addToClean (tmp_files_to_clean tmpfs) lifetime new_files + +addSubdirsToClean :: TmpFs -> TempFileLifetime -> [FilePath] -> IO () +addSubdirsToClean tmpfs lifetime new_subdirs = + addToClean (tmp_subdirs_to_clean tmpfs) lifetime new_subdirs + +addToClean :: IORef PathsToClean -> TempFileLifetime -> [FilePath] -> IO () +addToClean ref lifetime new_filepaths = modifyIORef' ref $ + \PathsToClean + { ptcCurrentModule = cm_paths + , ptcGhcSession = gs_paths } -> case lifetime of - TFL_CurrentModule -> FilesToClean - { ftcCurrentModule = cm_files `Set.union` new_files_set - , ftcGhcSession = gs_files `Set.difference` new_files_set + TFL_CurrentModule -> PathsToClean + { ptcCurrentModule = cm_paths `Set.union` new_filepaths_set + , ptcGhcSession = gs_paths `Set.difference` new_filepaths_set } - TFL_GhcSession -> FilesToClean - { ftcCurrentModule = cm_files `Set.difference` new_files_set - , ftcGhcSession = gs_files `Set.union` new_files_set + TFL_GhcSession -> PathsToClean + { ptcCurrentModule = cm_paths `Set.difference` new_filepaths_set + , ptcGhcSession = gs_paths `Set.union` new_filepaths_set } where - new_files_set = Set.fromList new_files + new_filepaths_set = Set.fromList new_filepaths -- | Update the lifetime of files already being tracked. If any files are -- not being tracked they will be discarded. changeTempFilesLifetime :: TmpFs -> TempFileLifetime -> [FilePath] -> IO () changeTempFilesLifetime tmpfs lifetime files = do - FilesToClean - { ftcCurrentModule = cm_files - , ftcGhcSession = gs_files + PathsToClean + { ptcCurrentModule = cm_paths + , ptcGhcSession = gs_paths } <- readIORef (tmp_files_to_clean tmpfs) let old_set = case lifetime of - TFL_CurrentModule -> gs_files - TFL_GhcSession -> cm_files + TFL_CurrentModule -> gs_paths + TFL_GhcSession -> cm_paths existing_files = [f | f <- files, f `Set.member` old_set] addFilesToClean tmpfs lifetime existing_files @@ -224,20 +252,32 @@ newTempName logger tmpfs tmp_dir lifetime extn addFilesToClean tmpfs lifetime [filename] return filename -newTempDir :: Logger -> TmpFs -> TempDir -> IO FilePath -newTempDir logger tmpfs tmp_dir +-- | Create a new temporary subdirectory that doesn't already exist +-- The temporary subdirectory is automatically removed at the end of the +-- GHC session, but its contents aren't. Make sure to leave the directory +-- empty before the end of the session, either by removing content +-- directly or by using @addFilesToClean at . +-- +-- If the created subdirectory is not empty, it will not be removed (along +-- with its parent temporary directory) and a warning message will be +-- printed at verbosity 2 and higher. +newTempSubDir :: Logger -> TmpFs -> TempDir -> IO FilePath +newTempSubDir logger tmpfs tmp_dir = do d <- getTempDir logger tmpfs tmp_dir findTempDir (d "ghc_") where findTempDir :: FilePath -> IO FilePath findTempDir prefix = do n <- newTempSuffix tmpfs - let filename = prefix ++ show n - b <- doesDirectoryExist filename + let name = prefix ++ show n + b <- doesDirectoryExist name if b then findTempDir prefix - else do createDirectory filename - -- see mkTempDir below; this is wrong: -> consIORef (tmp_dirs_to_clean tmpfs) filename - return filename + else (do + createDirectory name + addSubdirsToClean tmpfs TFL_GhcSession [name] + return name) + `Exception.catchIO` \e -> if isAlreadyExistsError e + then findTempDir prefix else ioError e newTempLibName :: Logger -> TmpFs -> TempDir -> TempFileLifetime -> Suffix -> IO (FilePath, FilePath, String) @@ -338,6 +378,12 @@ removeTmpFiles logger fs (non_deletees, deletees) = partition isHaskellUserSrcFilename fs +removeTmpSubdirs :: Logger -> [FilePath] -> IO () +removeTmpSubdirs logger fs + = traceCmd logger "Deleting temp subdirs" + ("Deleting: " ++ unwords fs) + (mapM_ (removeWith logger removeDirectory) fs) + removeWith :: Logger -> (FilePath -> IO ()) -> FilePath -> IO () removeWith logger remover f = remover f `Exception.catchIO` (\e -> View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f97c7f6d96c58579d630bc883929afc3d45d5c2b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f97c7f6d96c58579d630bc883929afc3d45d5c2b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 9 14:53:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 09 Mar 2023 09:53:02 -0500 Subject: [Git][ghc/ghc][master] Fixes #19627. Message-ID: <6409f2ceafb0c_2c78e937aa6cc06786be@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - 4 changed files: - compiler/GHC/Tc/Solver.hs - + testsuite/tests/typecheck/should_fail/T19627.hs - + testsuite/tests/typecheck/should_fail/T19627.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2371,7 +2371,7 @@ any new unifications, and iterate the implications only if so. -} {- Note [Expanding Recursive Superclasses and ExpansionFuel] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the class declaration (T21909) class C [a] => C a where @@ -2431,7 +2431,7 @@ There are two preconditions for the default fuel values: Precondition (1) ensures that we expand givens at least as many times as we expand wanted constraints preferably givenFuel > wantedsFuel to avoid issues like T21909 while the precondition (2) ensures that we do not reach the solver iteration limit and fail with a -more meaningful error message +more meaningful error message (see T19627) This also applies for quantified constraints; see `-fqcs-fuel` compiler flag and `QCI.qci_pend_sc` field. -} ===================================== testsuite/tests/typecheck/should_fail/T19627.hs ===================================== @@ -0,0 +1,108 @@ +{-# language BlockArguments #-} +{-# language DefaultSignatures #-} +{-# language DerivingStrategies #-} +{-# language EmptyCase #-} +{-# language ExplicitNamespaces #-} +{-# language ImportQualifiedPost #-} +{-# language FlexibleContexts #-} +{-# language FlexibleInstances #-} +{-# language FunctionalDependencies #-} +{-# language GADTs #-} +{-# language LambdaCase #-} +{-# language LinearTypes #-} +{-# language NoStarIsType #-} +{-# language PolyKinds #-} +{-# language QuantifiedConstraints #-} +{-# language RankNTypes #-} +{-# language RoleAnnotations #-} +{-# language ScopedTypeVariables #-} +{-# language StandaloneDeriving #-} +{-# language StandaloneKindSignatures #-} +{-# language StrictData #-} +{-# language TupleSections #-} +{-# language TypeApplications #-} +{-# language TypeFamilies #-} +{-# language TypeFamilyDependencies #-} +{-# language TypeOperators #-} +{-# language UndecidableInstances #-} +{-# language UndecidableSuperClasses #-} + +module T19627 where + +import Data.Kind +import Prelude hiding ( Functor(..) ) + +-------------------- + +class (Prop (Not p), Not (Not p) ~ p) => Prop (p :: Type) where + type Not p :: Type + (!=) :: p -> Not p -> r + +data Y (a :: Type) (b :: Type) (c :: Type) where + L :: Y a b a + R :: Y a b b + +newtype a & b = With (forall c. Y a b c -> c) + +with :: (forall c. Y a b c -> c) -> a & b +with = With + +runWith :: a & b -> Y a b c -> c +runWith (With f) = f + +withL' :: a & b -> a +withL' (With f) = f L + +withR' :: a & b -> b +withR' (With f) = f R + +instance (Prop a, Prop b) => Prop (a & b) where + type Not (a & b) = Not a `Either` Not b + w != Left a = withL' w != a + w != Right b = withR' w != b + +instance (Prop a, Prop b) => Prop (Either a b) where + type Not (Either a b) = Not a & Not b + Left a != w = a != withL' w + Right a != w = a != withR' w + +newtype Yoneda f a = Yoneda + (forall r. Prop r => (a -> r) -> f r) + +data Noneda f a where + Noneda :: Prop r => !(f r <#- (a ⊸ r)) -> Noneda f a + +liftYoneda :: forall f a i. (Functor f, Prop a, Iso i) => i (f a) (Yoneda f a) +liftYoneda = iso \case + L -> lowerYoneda' + R -> lol \case + L -> \(Noneda ((a2r :: a ⊸ r) :-#> nfr)) -> runLol (fmap @f @a @r a2r) L nfr + R -> \fa -> Yoneda do + lol \case + R -> \f -> fmap' f fa + L -> \nfr -> whyNot \a2r -> fmap a2r fa != nfr + + +type family NotApart (p :: Type -> Type -> Type) :: Type -> Type -> Type + +class + ( forall a b. (Prop a, Prop b) => Prop (p a b) + , NotApart (NotIso p) ~ p + ) => Iso p where + type NotIso p = (q :: Type -> Type -> Type) | q -> p + iso :: (forall c. Y (b ⊸ a) (a ⊸ b) c -> c) -> p a b + +data b <#- a where (:-#>) :: a -> Not b -> b <#- a +newtype a ⊸ b = Lol (forall c. Y (Not b %1 -> Not a) (a %1 -> b) c -> c) + +class + ( forall a. Prop a => Prop (f a) + ) => Functor f where + fmap' :: (Prop a, Prop b, Lol l, Lol l') => l ((a ⊸ b)) (l' (f a) (f b)) + +fmap :: forall f a b l. (Functor f, Prop a, Prop b, Lol l) => (a ⊸ b) -> l (f a) (f b) +fmap f = fmap' f + +class Iso p => Lol (p :: Type -> Type -> Type) where + lol :: (forall c. Y (Not b -> Not a) (a -> b) c -> c) -> p a b + apartR :: Not (p a b) -> b <#- a ===================================== testsuite/tests/typecheck/should_fail/T19627.stderr ===================================== @@ -0,0 +1,45 @@ + +T19627.hs:108:3: error: [GHC-05617] + • Could not deduce ‘Not (p0 a b) ~ Not (p a b)’ + from the context: Lol p + bound by the type signature for: + apartR :: forall (p :: * -> * -> *) a b. + Lol p => + Not (p a b) -> b <#- a + at T19627.hs:108:3-34 + Expected: Not (p a b) -> b <#- a + Actual: Not (p0 a b) -> b <#- a + NB: ‘Not’ is a non-injective type family + The type variable ‘p0’ is ambiguous + • In the ambiguity check for ‘apartR’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + When checking the class method: + apartR :: forall (p :: * -> * -> *) a b. + Lol p => + Not (p a b) -> b <#- a + In the class declaration for ‘Lol’ + +T19627.hs:108:3: error: [GHC-05617] + • Could not deduce ‘Not (Not (p0 a1 b1)) ~ p0 a1 b1’ + arising from a superclass required to satisfy ‘Prop (p0 a1 b1)’, + arising from the head of a quantified constraint + arising from a superclass required to satisfy ‘Iso p0’, + arising from a superclass required to satisfy ‘Lol p0’, + arising from a type ambiguity check for + the type signature for ‘apartR’ + from the context: Lol p + bound by the type signature for: + apartR :: forall (p :: * -> * -> *) a b. + Lol p => + Not (p a b) -> b <#- a + at T19627.hs:108:3-34 + or from: (Prop a1, Prop b1) + bound by a quantified context at T19627.hs:108:3-34 + The type variable ‘p0’ is ambiguous + • In the ambiguity check for ‘apartR’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + When checking the class method: + apartR :: forall (p :: * -> * -> *) a b. + Lol p => + Not (p a b) -> b <#- a + In the class declaration for ‘Lol’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -671,3 +671,4 @@ test('T20666a', normal, compile, ['']) # To become compile_fail after migration test('T22924a', normal, compile_fail, ['']) test('T22924b', normal, compile_fail, ['']) test('T22940', normal, compile_fail, ['']) +test('T19627', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ea719f2f1929bf2b789e4001f6c542a04185d61 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ea719f2f1929bf2b789e4001f6c542a04185d61 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 9 14:59:39 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 09 Mar 2023 09:59:39 -0500 Subject: [Git][ghc/ghc][wip/T23096] codeGen/tsan: Disable instrumentation of unaligned stores Message-ID: <6409f45b7fe69_2c78e937cd77ec680597@gitlab.mail> Ben Gamari pushed to branch wip/T23096 at Glasgow Haskell Compiler / GHC Commits: b5bbc334 by Ben Gamari at 2023-03-09T09:59:35-05:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 1 changed file: - compiler/GHC/Cmm/ThreadSanitizer.hs Changes: ===================================== compiler/GHC/Cmm/ThreadSanitizer.hs ===================================== @@ -54,11 +54,13 @@ annotateNode env node = CmmTick{} -> BMiddle node CmmUnwind{} -> BMiddle node CmmAssign{} -> annotateNodeOO env node - CmmStore lhs rhs align -> + -- TODO: Track unaligned stores + CmmStore lhs rhs Unaligned -> annotateNodeOO env node + CmmStore lhs rhs NaturallyAligned -> let ty = cmmExprType (platform env) rhs rhs_nodes = annotateLoads env (collectExprLoads rhs) lhs_nodes = annotateLoads env (collectExprLoads lhs) - st = tsanStore env align ty lhs + st = tsanStore env ty lhs in rhs_nodes `blockAppend` lhs_nodes `blockAppend` st `blockSnoc` node CmmUnsafeForeignCall (PrimTarget op) formals args -> let node' = fromMaybe (BMiddle node) (annotatePrim env op formals args) @@ -197,17 +199,14 @@ tsanTarget fn formals args = lbl = mkForeignLabel fn Nothing ForeignLabelInExternalPackage IsFunction tsanStore :: Env - -> AlignmentSpec -> CmmType -> CmmExpr + -> CmmType -> CmmExpr -> Block CmmNode O O -tsanStore env align ty addr = +tsanStore env ty addr = mkUnsafeCall env ftarget [] [addr] where ftarget = tsanTarget fn [] [AddrHint] w = widthInBytes (typeWidth ty) - fn = case align of - Unaligned - | w > 1 -> fsLit $ "__tsan_unaligned_write" ++ show w - _ -> fsLit $ "__tsan_write" ++ show w + fn = fsLit $ "__tsan_write" ++ show w tsanLoad :: Env -> AlignmentSpec -> CmmType -> CmmExpr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5bbc3349764f8fcbca49ee83370cfdff2a69460 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5bbc3349764f8fcbca49ee83370cfdff2a69460 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 9 15:08:23 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 09 Mar 2023 10:08:23 -0500 Subject: [Git][ghc/ghc][wip/tsan/fixes] 525 commits: Hadrian: fix ghcDebugAssertions off-by-one error Message-ID: <6409f6679bccc_2c78e93829f5e468609e@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes at Glasgow Haskell Compiler / GHC Commits: cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - 8da681b5 by Ben Gamari at 2023-03-09T10:05:35-05:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS, but it's a data race nevertheless. - - - - - 26cd9a59 by Ben Gamari at 2023-03-09T10:07:27-05:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 25 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/hello.hs - + .gitlab/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - + .gitlab/rel_eng/default.nix - + .gitlab/rel_eng/fetch-gitlab-artifacts/.gitignore - + .gitlab/rel_eng/fetch-gitlab-artifacts/README.mkd - + .gitlab/rel_eng/fetch-gitlab-artifacts/default.nix - + .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - + .gitlab/rel_eng/fetch-gitlab-artifacts/setup.py - + .gitlab/rel_eng/mk-ghcup-metadata/.gitignore - + .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - + .gitlab/rel_eng/mk-ghcup-metadata/default.nix - + .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - + .gitlab/rel_eng/mk-ghcup-metadata/setup.py - + .gitlab/rel_eng/nix/sources.json - + .gitlab/rel_eng/nix/sources.nix The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/246bdfa9cb8c91b875139cb6bb26b62a70a2a29c...26cd9a595d8a393315a1c896d8956ee63dadce26 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/246bdfa9cb8c91b875139cb6bb26b62a70a2a29c...26cd9a595d8a393315a1c896d8956ee63dadce26 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 9 15:18:57 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 09 Mar 2023 10:18:57 -0500 Subject: [Git][ghc/ghc][wip/tsan/fixes] 4 commits: Add `Data.Functor.unzip` Message-ID: <6409f8e14d0f_2c78e9383241e0688226@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes at Glasgow Haskell Compiler / GHC Commits: fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - 3dfa454c by Ben Gamari at 2023-03-08T16:58:59-05:00 compiler: Style fixes - - - - - c4a11baf by Ben Gamari at 2023-03-09T10:08:40-05:00 Merge remote-tracking branch 'origin/wip/tsan/fixes' into wip/tsan/fixes - - - - - 4 changed files: - compiler/GHC/Cmm/ThreadSanitizer.hs - libraries/base/Data/Functor.hs - libraries/base/Debug/Trace.hs - libraries/base/changelog.md Changes: ===================================== compiler/GHC/Cmm/ThreadSanitizer.hs ===================================== @@ -37,11 +37,11 @@ mapBlockList :: (forall e' x'. n e' x' -> Block n e' x') mapBlockList f (BlockCO n rest ) = f n `blockAppend` mapBlockList f rest mapBlockList f (BlockCC n rest m) = f n `blockAppend` mapBlockList f rest `blockAppend` f m mapBlockList f (BlockOC rest m) = mapBlockList f rest `blockAppend` f m -mapBlockList _ BNil = BNil -mapBlockList f (BMiddle blk) = f blk -mapBlockList f (BCat a b) = mapBlockList f a `blockAppend` mapBlockList f b -mapBlockList f (BSnoc a n) = mapBlockList f a `blockAppend` f n -mapBlockList f (BCons n a) = f n `blockAppend` mapBlockList f a +mapBlockList _ BNil = BNil +mapBlockList f (BMiddle blk) = f blk +mapBlockList f (BCat a b) = mapBlockList f a `blockAppend` mapBlockList f b +mapBlockList f (BSnoc a n) = mapBlockList f a `blockAppend` f n +mapBlockList f (BCons n a) = f n `blockAppend` mapBlockList f a annotateBlock :: Env -> Block CmmNode e x -> Block CmmNode e x annotateBlock env = mapBlockList (annotateNode env) @@ -112,10 +112,10 @@ annotatePrim :: Env -> [CmmActual] -- ^ arguments -> Maybe (Block CmmNode O O) -- ^ 'Just' a block of instrumentation, if applicable -annotatePrim env (MO_AtomicRMW w aop) [dest] [addr, val] = Just $ tsanAtomicRMW env MemOrderSeqCst aop w addr val dest -annotatePrim env (MO_AtomicRead w mord) [dest] [addr] = Just $ tsanAtomicLoad env mord w addr dest -annotatePrim env (MO_AtomicWrite w mord) [] [addr, val] = Just $ tsanAtomicStore env mord w val addr -annotatePrim env (MO_Xchg w) [dest] [addr, val] = Just $ tsanAtomicExchange env MemOrderSeqCst w val addr dest +annotatePrim env (MO_AtomicRMW w aop) [dest] [addr, val] = Just $ tsanAtomicRMW env MemOrderSeqCst aop w addr val dest +annotatePrim env (MO_AtomicRead w mord) [dest] [addr] = Just $ tsanAtomicLoad env mord w addr dest +annotatePrim env (MO_AtomicWrite w mord) [] [addr, val] = Just $ tsanAtomicStore env mord w val addr +annotatePrim env (MO_Xchg w) [dest] [addr, val] = Just $ tsanAtomicExchange env MemOrderSeqCst w val addr dest annotatePrim env (MO_Cmpxchg w) [dest] [addr, expected, new] = Just $ tsanAtomicCas env MemOrderSeqCst MemOrderSeqCst w addr expected new dest annotatePrim _ _ _ _ = Nothing ===================================== libraries/base/Data/Functor.hs ===================================== @@ -43,10 +43,12 @@ module Data.Functor ($>), (<$>), (<&>), + unzip, void, ) where import GHC.Base ( Functor(..), flip ) +import Data.Tuple ( fst, snd ) -- $setup -- Allow the use of Prelude in doctests. @@ -159,6 +161,9 @@ infixl 4 $> ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$) +unzip :: Functor f => f (a,b) -> (f a, f b) +unzip xs = (fst <$> xs, snd <$> xs) + -- | @'void' value@ discards or ignores the result of evaluation, such -- as the return value of an 'System.IO.IO' action. -- ===================================== libraries/base/Debug/Trace.hs ===================================== @@ -173,7 +173,7 @@ Like 'trace', but outputs the result of calling a function on the argument. hello ("hello","world") - at since 4.17.0.0 + at since 4.18.0.0 -} traceWith :: (a -> String) -> a -> a traceWith f a = trace (f a) a @@ -186,7 +186,7 @@ a 'String'. 3 [1,2,3] - at since 4.17.0.0 + at since 4.18.0.0 -} traceShowWith :: Show b => (a -> b) -> a -> a traceShowWith f = traceWith (show . f) @@ -303,7 +303,7 @@ traceEventIO msg = -- | Like 'traceEvent', but emits the result of calling a function on its -- argument. -- --- @since 4.17.0.0 +-- @since 4.18.0.0 traceEventWith :: (a -> String) -> a -> a traceEventWith f a = traceEvent (f a) a ===================================== libraries/base/changelog.md ===================================== @@ -11,6 +11,7 @@ ([CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113)) * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) + * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) ## 4.18.0.0 *TBA* @@ -82,6 +83,9 @@ * `InfoProv` now has additional `ipSrcFile` and `ipSrcSpan` fields. `ipLoc` is now a function computed from these fields. * The `whereFrom` function has been moved + * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to + `Debug.Trace`, per + [CLC proposal #36](https://github.com/haskell/core-libraries-committee/issues/36). ## 4.17.0.0 *August 2022* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26cd9a595d8a393315a1c896d8956ee63dadce26...c4a11baffa2f1d02748ddaa00e49bbd7e40d5441 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26cd9a595d8a393315a1c896d8956ee63dadce26...c4a11baffa2f1d02748ddaa00e49bbd7e40d5441 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 06:39:41 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Fri, 10 Mar 2023 01:39:41 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/js-MK_JSVAL Message-ID: <640ad0ad56ef8_2c78e947472038757938@gitlab.mail> Josh Meredith pushed new branch wip/js-MK_JSVAL at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-MK_JSVAL You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 07:06:28 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 02:06:28 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-9.6 Message-ID: <640ad6f43fc63_2c78e947ba265076360@gitlab.mail> Ben Gamari pushed new branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 07:11:35 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 02:11:35 -0500 Subject: [Git][ghc/ghc][wip/backports-9.6] 4 commits: Don't generate datacon wrappers for `type data` declarations Message-ID: <640ad827e9428_2c78e947c35bf876710@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC Commits: 9706e3de by Ryan Scott at 2023-03-10T02:11:16-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. (cherry picked from commit 4327d63594f73939a2b8ab015c1cb44eafd4b460) - - - - - d81d0a0e by Ryan Scott at 2023-03-10T02:11:16-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. (cherry picked from commit 96dc58b9225d91a7912957c6be5d9c7a95e51718) - - - - - 34172066 by Ryan Scott at 2023-03-10T02:11:16-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. (cherry picked from commit ff8e99f69b203559b784014ab26c59b5553d128a) - - - - - 825a81e5 by Ben Gamari at 2023-03-10T02:11:16-05:00 Set RELEASE=YES - - - - - 19 changed files: - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Make.hs - configure.ac - + testsuite/tests/pmcheck/should_compile/T22964.hs - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/type-data/should_compile/T22948b.hs - + testsuite/tests/type-data/should_compile/T22948b.stderr - testsuite/tests/type-data/should_compile/all.T - + testsuite/tests/type-data/should_fail/TDTagToEnum.hs - + testsuite/tests/type-data/should_fail/TDTagToEnum.stderr - testsuite/tests/type-data/should_fail/all.T - + testsuite/tests/type-data/should_run/T22948a.hs - testsuite/tests/type-data/should_run/all.T Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -730,9 +730,8 @@ refineDefaultAlt :: [Unique] -- ^ Uniques for constructing new binders refineDefaultAlt us mult tycon tys imposs_deflt_cons all_alts | Alt DEFAULT _ rhs : rest_alts <- all_alts , isAlgTyCon tycon -- It's a data type, tuple, or unboxed tuples. - , not (isNewTyCon tycon) -- We can have a newtype, if we are just doing an eval: - -- case x of { DEFAULT -> e } - -- and we don't want to fill in a default for them! + , not (isNewTyCon tycon) -- Exception 1 in Note [Refine DEFAULT case alternatives] + , not (isTypeDataTyCon tycon) -- Exception 2 in Note [Refine DEFAULT case alternatives] , Just all_cons <- tyConDataCons_maybe tycon , let imposs_data_cons = mkUniqSet [con | DataAlt con <- imposs_deflt_cons] -- We now know it's a data type, so we can use @@ -817,6 +816,39 @@ with a specific constructor is desirable. `imposs_deflt_cons` argument is populated with constructors which are matched elsewhere. +There are two exceptions where we avoid refining a DEFAULT case: + +* Exception 1: Newtypes + + We can have a newtype, if we are just doing an eval: + + case x of { DEFAULT -> e } + + And we don't want to fill in a default for them! + +* Exception 2: `type data` declarations + + The data constructors for a `type data` declaration (see + Note [Type data declarations] in GHC.Rename.Module) do not exist at the + value level. Nevertheless, it is possible to strictly evaluate a value + whose type is a `type data` declaration. Test case + type-data/should_compile/T2294b.hs contains an example: + + type data T a where + A :: T Int + + f :: T a -> () + f !x = () + + We want to generate the following Core for f: + + f = \(@a) (x :: T a) -> + case x of + __DEFAULT -> () + + Namely, we do _not_ want to match on `A`, as it doesn't exist at the value + level! + Note [Combine identical alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If several alternatives are identical, merge them into a single ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -147,11 +147,16 @@ updRcm f (RCM vanilla pragmas) -- Ex.: @vanillaCompleteMatchTC 'Maybe' ==> Just ("Maybe", {'Just','Nothing'})@ vanillaCompleteMatchTC :: TyCon -> Maybe CompleteMatch vanillaCompleteMatchTC tc = - let -- TYPE acts like an empty data type on the term-level (#14086), but - -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a - -- special case. - mb_dcs | tc == tYPETyCon = Just [] - | otherwise = tyConDataCons_maybe tc + let mb_dcs | -- TYPE acts like an empty data type on the term level (#14086), + -- but it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. + -- Hence a special case. + tc == tYPETyCon = Just [] + | -- Similarly, treat `type data` declarations as empty data types on + -- the term level, as `type data` data constructors only exist at + -- the type level (#22964). + -- See Note [Type data declarations] in GHC.Rename.Module. + isTypeDataTyCon tc = Just [] + | otherwise = tyConDataCons_maybe tc in vanillaCompleteMatch . mkUniqDSet . map RealDataCon <$> mb_dcs -- | Initialise from 'dsGetCompleteMatches' (containing all COMPLETE pragmas) ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2139,6 +2139,54 @@ The main parts of the implementation are: `type data` declarations. When these are converted back to Hs types in a splice, the constructors are placed in the TcCls namespace. +* A `type data` declaration _never_ generates wrappers for its data + constructors, as they only make sense for value-level data constructors. + See `wrapped_reqd` in GHC.Types.Id.Make.mkDataConRep` for the place where + this check is implemented. + + This includes `type data` declarations implemented as GADTs, such as + this example from #22948: + + type data T a where + A :: T Int + B :: T a + + If `T` were an ordinary `data` declaration, then `A` would have a wrapper + to account for the GADT-like equality in its return type. Because `T` is + declared as a `type data` declaration, however, the wrapper is omitted. + +* Although `type data` data constructors do not exist at the value level, + it is still possible to match on a value whose type is headed by a `type data` + type constructor, such as this example from #22964: + + type data T a where + A :: T Int + B :: T a + + f :: T a -> () + f x = case x of {} + + This has two consequences: + + * During checking the coverage of `f`'s pattern matches, we treat `T` as if it + were an empty data type so that GHC does not warn the user to match against + `A` or `B`. (Otherwise, you end up with the bug reported in #22964.) + See GHC.HsToCore.Pmc.Solver.vanillaCompleteMatchTC. + + * In `GHC.Core.Utils.refineDataAlt`, do /not/ fill in the DEFAULT case with + the data constructor. See + Note [Refine DEFAULT case alternatives] Exception 2, in GHC.Core.Utils. + +* To prevent users from conjuring up `type data` values at the term level, we + disallow using the tagToEnum# function on a type headed by a `type data` + type. For instance, GHC will reject this code: + + type data Letter = A | B | C + + f :: Letter + f = tagToEnum# 0# + + See `GHC.Tc.Gen.App.checkTagToEnum`, specifically `check_enumeration`. -} warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -276,6 +276,10 @@ instance Diagnostic TcRnMessage where -> mkSimpleDecorated $ hang (text "Bad call to tagToEnum# at type" <+> ppr ty) 2 (text "Result type must be an enumeration type") + TcRnTagToEnumResTyTypeData ty + -> mkSimpleDecorated $ + hang (text "Bad call to tagToEnum# at type" <+> ppr ty) + 2 (text "Result type cannot be headed by a `type data` type") TcRnArrowIfThenElsePredDependsOnResultTy -> mkSimpleDecorated $ text "Predicate type of `ifThenElse' depends on result type" @@ -1307,6 +1311,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnTagToEnumResTyNotAnEnum{} -> ErrorWithoutFlag + TcRnTagToEnumResTyTypeData{} + -> ErrorWithoutFlag TcRnArrowIfThenElsePredDependsOnResultTy -> ErrorWithoutFlag TcRnIllegalHsBootFileDecl @@ -1713,6 +1719,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnTagToEnumResTyNotAnEnum{} -> noHints + TcRnTagToEnumResTyTypeData{} + -> noHints TcRnArrowIfThenElsePredDependsOnResultTy -> noHints TcRnIllegalHsBootFileDecl ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -663,6 +663,20 @@ data TcRnMessage where -} TcRnTagToEnumResTyNotAnEnum :: Type -> TcRnMessage + {-| TcRnTagToEnumResTyTypeData is an error that occurs when the 'tagToEnum#' + function is given a result type that is headed by a @type data@ type, as + the data constructors of a @type data@ do not exist at the term level. + + Example(s): + type data Letter = A | B | C + + foo :: Letter + foo = tagToEnum# 0# + + Test cases: type-data/should_fail/TDTagToEnum.hs + -} + TcRnTagToEnumResTyTypeData :: Type -> TcRnMessage + {-| TcRnArrowIfThenElsePredDependsOnResultTy is an error that occurs when the predicate type of an ifThenElse expression in arrow notation depends on the type of the result. ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -1226,6 +1226,8 @@ tcTagToEnum tc_fun fun_ctxt tc_args res_ty vanilla_result = rebuildHsApps tc_fun fun_ctxt tc_args res_ty check_enumeration ty' tc + | -- isTypeDataTyCon: see Note [Type data declarations] in GHC.Rename.Module + isTypeDataTyCon tc = addErrTc (TcRnTagToEnumResTyTypeData ty') | isEnumerationTyCon tc = return () | otherwise = addErrTc (TcRnTagToEnumResTyNotAnEnum ty') ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -354,6 +354,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnTagToEnumMissingValArg" = 36495 GhcDiagnosticCode "TcRnTagToEnumUnspecifiedResTy" = 08522 GhcDiagnosticCode "TcRnTagToEnumResTyNotAnEnum" = 49356 + GhcDiagnosticCode "TcRnTagToEnumResTyTypeData" = 96189 GhcDiagnosticCode "TcRnArrowIfThenElsePredDependsOnResultTy" = 55868 GhcDiagnosticCode "TcRnIllegalHsBootFileDecl" = 58195 GhcDiagnosticCode "TcRnRecursivePatternSynonym" = 72489 ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -784,20 +784,40 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con (unboxers, boxers) = unzip wrappers (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs) + -- This is True if the data constructor or class dictionary constructor + -- needs a wrapper. This wrapper is injected into the program later in the + -- CoreTidy pass. See Note [Injecting implicit bindings] in GHC.Iface.Tidy, + -- along with the accompanying implementation in getTyConImplicitBinds. wrapper_reqd = (not new_tycon -- (Most) newtypes have only a worker, with the exception - -- of some newtypes written with GADT syntax. See below. + -- of some newtypes written with GADT syntax. + -- See dataConUserTyVarsNeedWrapper below. && (any isBanged (ev_ibangs ++ arg_ibangs))) -- Some forcing/unboxing (includes eq_spec) || isFamInstTyCon tycon -- Cast result - || dataConUserTyVarsNeedWrapper data_con + || (dataConUserTyVarsNeedWrapper data_con -- If the data type was written with GADT syntax and -- orders the type variables differently from what the -- worker expects, it needs a data con wrapper to reorder -- the type variables. -- See Note [Data con wrappers and GADT syntax]. - -- NB: All GADTs return true from this function + -- + -- NB: All GADTs return true from this function, but there + -- is one exception that we must check below. + && not (isTypeDataTyCon tycon)) + -- An exception to this rule is `type data` declarations. + -- Their data constructors only live at the type level and + -- therefore do not need wrappers. + -- See Note [Type data declarations] in GHC.Rename.Module. + -- + -- Note that the other checks in this definition will + -- return False for `type data` declarations, as: + -- + -- - They cannot be newtypes + -- - They cannot have strict fields + -- - They cannot be data family instances + -- - They cannot have datatype contexts || not (null stupid_theta) -- If the data constructor has a datatype context, -- we need a wrapper in order to drop the stupid arguments. ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.1], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058). However, the version must have three components # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are @@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.0], [glasgow-has AC_CONFIG_MACRO_DIRS([m4]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=NO} +: ${RELEASE=YES} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the ===================================== testsuite/tests/pmcheck/should_compile/T22964.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE TypeData #-} +module X where + +type data T1 a where + A1 :: T1 Int + B1 :: T1 a + +f1 :: T1 a -> () +f1 x = case x of {} + +type data T2 a where + A2 :: T2 Int + +f2 :: T2 a -> () +f2 x = case x of {} ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -158,3 +158,4 @@ test('EmptyCase009', [], compile, [overlapping_incomplete]) test('EmptyCase010', [], compile, [overlapping_incomplete]) test('T19271', [], compile, [overlapping_incomplete]) test('T21761', [], compile, [overlapping_incomplete]) +test('T22964', [], compile, [overlapping_incomplete]) ===================================== testsuite/tests/type-data/should_compile/T22948b.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module T22948b where + +type data T a where + A :: T Int + +f :: T a -> () +f !x = () ===================================== testsuite/tests/type-data/should_compile/T22948b.stderr ===================================== @@ -0,0 +1,4 @@ + +T22948b.hs:8:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘f’: f !x = ... ===================================== testsuite/tests/type-data/should_compile/all.T ===================================== @@ -5,3 +5,4 @@ test('TDGoodConsConstraints', normal, compile, ['']) test('TDVector', normal, compile, ['']) test('TD_TH_splice', normal, compile, ['']) test('T22315a', [extra_files(['T22315a/'])], multimod_compile, ['T22315a.Lib T22315a.Main', '-v0']) +test('T22948b', normal, compile, ['']) ===================================== testsuite/tests/type-data/should_fail/TDTagToEnum.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeData #-} +module TDTagToEnum where + +import GHC.Exts (tagToEnum#) + +type data Letter = A | B | C + +f :: Letter +f = tagToEnum# 0# ===================================== testsuite/tests/type-data/should_fail/TDTagToEnum.stderr ===================================== @@ -0,0 +1,6 @@ + +TDTagToEnum.hs:10:5: error: [GHC-96189] + • Bad call to tagToEnum# at type Letter + Result type cannot be headed by a `type data` type + • In the expression: tagToEnum# 0# + In an equation for ‘f’: f = tagToEnum# 0# ===================================== testsuite/tests/type-data/should_fail/all.T ===================================== @@ -11,4 +11,5 @@ test('TDRecordsH98', normal, compile_fail, ['']) test('TDRecursive', normal, compile_fail, ['']) test('TDStrictnessGADT', normal, compile_fail, ['']) test('TDStrictnessH98', normal, compile_fail, ['']) +test('TDTagToEnum', normal, compile_fail, ['']) test('T22332b', normal, compile_fail, ['']) ===================================== testsuite/tests/type-data/should_run/T22948a.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module Main where + +type data T a where + A :: T Int + B :: T a + +main = return () ===================================== testsuite/tests/type-data/should_run/all.T ===================================== @@ -1,3 +1,4 @@ test('T22332a', exit_code(1), compile_and_run, ['']) test('T22315b', extra_files(['T22315b.hs']), ghci_script, ['T22315b.script']) test('T22500', normal, compile_and_run, ['']) +test('T22948a', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/533a9e3d0862c4175c153520a639de233d549ead...825a81e5472382336c29228947718b1d40c8c6d9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/533a9e3d0862c4175c153520a639de233d549ead...825a81e5472382336c29228947718b1d40c8c6d9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 07:34:40 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 02:34:40 -0500 Subject: [Git][ghc/ghc][wip/backports-9.6] 2 commits: Bump haddock submodule to 2.28 Message-ID: <640add90d5c9e_36ed6c1100447746f@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC Commits: 87ab8e35 by Ben Gamari at 2023-03-10T02:34:36-05:00 Bump haddock submodule to 2.28 - - - - - 1f5bce0d by Ben Gamari at 2023-03-10T02:34:36-05:00 Set RELEASE=YES - - - - - 2 changed files: - configure.ac - utils/haddock Changes: ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.1], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058). However, the version must have three components # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are @@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.6.0], [glasgow-has AC_CONFIG_MACRO_DIRS([m4]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=NO} +: ${RELEASE=YES} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 37e3c3683ac70735ab211f59210c9abea8ae2c69 +Subproject commit 9696d0daddea2f6850ee8b0f461bb642bca4e8f5 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/825a81e5472382336c29228947718b1d40c8c6d9...1f5bce0db8821f0dadd7ef360b0654933c3dcf1e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/825a81e5472382336c29228947718b1d40c8c6d9...1f5bce0db8821f0dadd7ef360b0654933c3dcf1e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 09:56:06 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 10 Mar 2023 04:56:06 -0500 Subject: [Git][ghc/ghc][wip/T22194] 108 commits: Add clangd flag to include generated header files Message-ID: <640afeb6dfb31_36ed6c269d3c010055@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194 at Glasgow Haskell Compiler / GHC Commits: 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - c9efc3b6 by Simon Peyton Jones at 2023-03-07T08:44:43+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - 9a8e9a74 by Simon Peyton Jones at 2023-03-07T12:50:53+00:00 Wibbles - - - - - 2c33414c by Simon Peyton Jones at 2023-03-10T09:55:00+00:00 DRAFT: Refactor the way we establish a canonical constraint Relevant to #22194 Incomplete; but I'd like to see the CI results - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitlab/test-metrics.sh - CODEOWNERS - cabal.project-reinstall - compile_flags.txt - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/081640f1e0b5a9def306f3e13c1825fef5403c95...2c33414c79dde79d3099f07200e3038044db1236 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/081640f1e0b5a9def306f3e13c1825fef5403c95...2c33414c79dde79d3099f07200e3038044db1236 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 12:38:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Mar 2023 07:38:58 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Delete created temporary subdirectories at end of session. Message-ID: <640b24e2a3323_36ed6c54fde041286f6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - 26170dee by Sebastian Graf at 2023-03-10T07:38:36-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 32163a18 by Sylvain Henry at 2023-03-10T07:38:48-05:00 JS: remove dead code for old integer-gmp - - - - - 10 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Utils/TmpFs.hs - rts/js/rts.js - + testsuite/tests/stranal/should_compile/T22997.hs - testsuite/tests/stranal/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T19627.hs - + testsuite/tests/typecheck/should_fail/T19627.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1916,10 +1916,11 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- Check for an OPAQUE function: see Note [OPAQUE pragma] -- In that case, trim off all boxity info from argument demands + -- and demand info on lambda binders -- See Note [The OPAQUE pragma and avoiding the reboxing of arguments] | isOpaquePragma (idInlinePragma fn) , let trimmed_rhs_dmds = map trimBoxity rhs_dmds - = (trimmed_rhs_dmds, add_demands trimmed_rhs_dmds rhs) + = (trimmed_rhs_dmds, set_lam_dmds trimmed_rhs_dmds rhs) -- Check that we have enough visible binders to match the -- threshold arity; if not, we won't do worker/wrapper @@ -1939,8 +1940,8 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- vcat [text "function:" <+> ppr fn -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ - (arg_dmds', add_demands arg_dmds' rhs) - -- add_demands: we must attach the final boxities to the lambda-binders + (arg_dmds', set_lam_dmds arg_dmds' rhs) + -- set_lam_dmds: we must attach the final boxities to the lambda-binders -- of the function, both because that's kosher, and because CPR analysis -- uses the info on the binders directly. where @@ -2032,17 +2033,18 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs | positiveTopBudget bg_inner' = (bg_inner', dmd') | otherwise = (bg_inner, trimBoxity dmd) - add_demands :: [Demand] -> CoreExpr -> CoreExpr + set_lam_dmds :: [Demand] -> CoreExpr -> CoreExpr -- Attach the demands to the outer lambdas of this expression - add_demands [] e = e - add_demands (dmd:dmds) (Lam v e) - | isTyVar v = Lam v (add_demands (dmd:dmds) e) - | otherwise = Lam (v `setIdDemandInfo` dmd) (add_demands dmds e) - add_demands dmds (Cast e co) = Cast (add_demands dmds e) co + set_lam_dmds (dmd:dmds) (Lam v e) + | isTyVar v = Lam v (set_lam_dmds (dmd:dmds) e) + | otherwise = Lam (v `setIdDemandInfo` dmd) (set_lam_dmds dmds e) + set_lam_dmds dmds (Cast e co) = Cast (set_lam_dmds dmds e) co -- This case happens for an OPAQUE function, which may look like -- f = (\x y. blah) |> co -- We give it strictness but no boxity (#22502) - add_demands dmds e = pprPanic "add_demands" (ppr dmds $$ ppr e) + set_lam_dmds _ e = e + -- In the OPAQUE case, the list of demands at this point might be + -- non-empty, e.g., when looking at a PAP. Hence don't panic (#22997). finaliseLetBoxity :: AnalEnv ===================================== compiler/GHC/Linker/Static.hs ===================================== @@ -126,7 +126,7 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do if gopt Opt_SingleLibFolder dflags then do libs <- getLibs namever ways_ unit_env dep_units - tmpDir <- newTempDir logger tmpfs (tmpDir dflags) + tmpDir <- newTempSubDir logger tmpfs (tmpDir dflags) sequence_ [ copyFile lib (tmpDir basename) | (lib, basename) <- libs] return [ "-L" ++ tmpDir ] ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2371,7 +2371,7 @@ any new unifications, and iterate the implications only if so. -} {- Note [Expanding Recursive Superclasses and ExpansionFuel] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the class declaration (T21909) class C [a] => C a where @@ -2431,7 +2431,7 @@ There are two preconditions for the default fuel values: Precondition (1) ensures that we expand givens at least as many times as we expand wanted constraints preferably givenFuel > wantedsFuel to avoid issues like T21909 while the precondition (2) ensures that we do not reach the solver iteration limit and fail with a -more meaningful error message +more meaningful error message (see T19627) This also applies for quantified constraints; see `-fqcs-fuel` compiler flag and `QCI.qci_pend_sc` field. -} ===================================== compiler/GHC/Utils/TmpFs.hs ===================================== @@ -6,8 +6,8 @@ module GHC.Utils.TmpFs , initTmpFs , forkTmpFsFrom , mergeTmpFsInto - , FilesToClean(..) - , emptyFilesToClean + , PathsToClean(..) + , emptyPathsToClean , TempFileLifetime(..) , TempDir (..) , cleanTempDirs @@ -17,7 +17,7 @@ module GHC.Utils.TmpFs , changeTempFilesLifetime , newTempName , newTempLibName - , newTempDir + , newTempSubDir , withSystemTempDirectory , withTempDirectory ) @@ -63,25 +63,29 @@ data TmpFs = TmpFs -- -- Shared with forked TmpFs. - , tmp_files_to_clean :: IORef FilesToClean + , tmp_files_to_clean :: IORef PathsToClean -- ^ Files to clean (per session or per module) -- -- Not shared with forked TmpFs. + , tmp_subdirs_to_clean :: IORef PathsToClean + -- ^ Subdirs to clean (per session or per module) + -- + -- Not shared with forked TmpFs. } --- | A collection of files that must be deleted before ghc exits. -data FilesToClean = FilesToClean - { ftcGhcSession :: !(Set FilePath) - -- ^ Files that will be deleted at the end of runGhc(T) +-- | A collection of paths that must be deleted before ghc exits. +data PathsToClean = PathsToClean + { ptcGhcSession :: !(Set FilePath) + -- ^ Paths that will be deleted at the end of runGhc(T) - , ftcCurrentModule :: !(Set FilePath) - -- ^ Files that will be deleted the next time + , ptcCurrentModule :: !(Set FilePath) + -- ^ Paths that will be deleted the next time -- 'cleanCurrentModuleTempFiles' is called, or otherwise at the end of -- the session. } -- | Used when a temp file is created. This determines which component Set of --- FilesToClean will get the temp file +-- PathsToClean will get the temp file data TempFileLifetime = TFL_CurrentModule -- ^ A file with lifetime TFL_CurrentModule will be cleaned up at the @@ -93,38 +97,45 @@ data TempFileLifetime newtype TempDir = TempDir FilePath --- | An empty FilesToClean -emptyFilesToClean :: FilesToClean -emptyFilesToClean = FilesToClean Set.empty Set.empty +-- | An empty PathsToClean +emptyPathsToClean :: PathsToClean +emptyPathsToClean = PathsToClean Set.empty Set.empty --- | Merge two FilesToClean -mergeFilesToClean :: FilesToClean -> FilesToClean -> FilesToClean -mergeFilesToClean x y = FilesToClean - { ftcGhcSession = Set.union (ftcGhcSession x) (ftcGhcSession y) - , ftcCurrentModule = Set.union (ftcCurrentModule x) (ftcCurrentModule y) +-- | Merge two PathsToClean +mergePathsToClean :: PathsToClean -> PathsToClean -> PathsToClean +mergePathsToClean x y = PathsToClean + { ptcGhcSession = Set.union (ptcGhcSession x) (ptcGhcSession y) + , ptcCurrentModule = Set.union (ptcCurrentModule x) (ptcCurrentModule y) } -- | Initialise an empty TmpFs initTmpFs :: IO TmpFs initTmpFs = do - files <- newIORef emptyFilesToClean - dirs <- newIORef Map.empty - next <- newIORef 0 + files <- newIORef emptyPathsToClean + subdirs <- newIORef emptyPathsToClean + dirs <- newIORef Map.empty + next <- newIORef 0 return $ TmpFs - { tmp_files_to_clean = files - , tmp_dirs_to_clean = dirs - , tmp_next_suffix = next + { tmp_files_to_clean = files + , tmp_subdirs_to_clean = subdirs + , tmp_dirs_to_clean = dirs + , tmp_next_suffix = next } -- | Initialise an empty TmpFs sharing unique numbers and per-process temporary -- directories with the given TmpFs +-- +-- It's not safe to use the subdirs created by the original TmpFs with the +-- forked one. Use @newTempSubDir@ to create new subdirs instead. forkTmpFsFrom :: TmpFs -> IO TmpFs forkTmpFsFrom old = do - files <- newIORef emptyFilesToClean + files <- newIORef emptyPathsToClean + subdirs <- newIORef emptyPathsToClean return $ TmpFs - { tmp_files_to_clean = files - , tmp_dirs_to_clean = tmp_dirs_to_clean old - , tmp_next_suffix = tmp_next_suffix old + { tmp_files_to_clean = files + , tmp_subdirs_to_clean = subdirs + , tmp_dirs_to_clean = tmp_dirs_to_clean old + , tmp_next_suffix = tmp_next_suffix old } -- | Merge the first TmpFs into the second. @@ -132,8 +143,11 @@ forkTmpFsFrom old = do -- The first TmpFs is returned emptied. mergeTmpFsInto :: TmpFs -> TmpFs -> IO () mergeTmpFsInto src dst = do - src_files <- atomicModifyIORef' (tmp_files_to_clean src) (\s -> (emptyFilesToClean, s)) - atomicModifyIORef' (tmp_files_to_clean dst) (\s -> (mergeFilesToClean src_files s, ())) + src_files <- atomicModifyIORef' (tmp_files_to_clean src) (\s -> (emptyPathsToClean, s)) + src_subdirs <- atomicModifyIORef' (tmp_subdirs_to_clean src) (\s -> (emptyPathsToClean, s)) + atomicModifyIORef' (tmp_files_to_clean dst) (\s -> (mergePathsToClean src_files s, ())) + atomicModifyIORef' (tmp_subdirs_to_clean dst) (\s -> (mergePathsToClean src_subdirs s, ())) + cleanTempDirs :: Logger -> TmpFs -> IO () cleanTempDirs logger tmpfs @@ -142,64 +156,78 @@ cleanTempDirs logger tmpfs ds <- atomicModifyIORef' ref $ \ds -> (Map.empty, ds) removeTmpDirs logger (Map.elems ds) --- | Delete all files in @tmp_files_to_clean at . +-- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean at . cleanTempFiles :: Logger -> TmpFs -> IO () cleanTempFiles logger tmpfs = mask_ - $ do let ref = tmp_files_to_clean tmpfs - to_delete <- atomicModifyIORef' ref $ - \FilesToClean - { ftcCurrentModule = cm_files - , ftcGhcSession = gs_files - } -> ( emptyFilesToClean - , Set.toList cm_files ++ Set.toList gs_files) - removeTmpFiles logger to_delete - --- | Delete all files in @tmp_files_to_clean at . That have lifetime --- TFL_CurrentModule. + $ do removeWith (removeTmpFiles logger) (tmp_files_to_clean tmpfs) + removeWith (removeTmpSubdirs logger) (tmp_subdirs_to_clean tmpfs) + where + removeWith remove ref = do + to_delete <- atomicModifyIORef' ref $ + \PathsToClean + { ptcCurrentModule = cm_paths + , ptcGhcSession = gs_paths + } -> ( emptyPathsToClean + , Set.toList cm_paths ++ Set.toList gs_paths) + remove to_delete + +-- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@ +-- That have lifetime TFL_CurrentModule. -- If a file must be cleaned eventually, but must survive a -- cleanCurrentModuleTempFiles, ensure it has lifetime TFL_GhcSession. cleanCurrentModuleTempFiles :: Logger -> TmpFs -> IO () cleanCurrentModuleTempFiles logger tmpfs = mask_ - $ do let ref = tmp_files_to_clean tmpfs + $ do removeWith (removeTmpFiles logger) (tmp_files_to_clean tmpfs) + removeWith (removeTmpSubdirs logger) (tmp_subdirs_to_clean tmpfs) + where + removeWith remove ref = do to_delete <- atomicModifyIORef' ref $ - \ftc at FilesToClean{ftcCurrentModule = cm_files} -> - (ftc {ftcCurrentModule = Set.empty}, Set.toList cm_files) - removeTmpFiles logger to_delete + \ptc at PathsToClean{ptcCurrentModule = cm_paths} -> + (ptc {ptcCurrentModule = Set.empty}, Set.toList cm_paths) + remove to_delete -- | Ensure that new_files are cleaned on the next call of -- 'cleanTempFiles' or 'cleanCurrentModuleTempFiles', depending on lifetime. -- If any of new_files are already tracked, they will have their lifetime -- updated. addFilesToClean :: TmpFs -> TempFileLifetime -> [FilePath] -> IO () -addFilesToClean tmpfs lifetime new_files = modifyIORef' (tmp_files_to_clean tmpfs) $ - \FilesToClean - { ftcCurrentModule = cm_files - , ftcGhcSession = gs_files +addFilesToClean tmpfs lifetime new_files = + addToClean (tmp_files_to_clean tmpfs) lifetime new_files + +addSubdirsToClean :: TmpFs -> TempFileLifetime -> [FilePath] -> IO () +addSubdirsToClean tmpfs lifetime new_subdirs = + addToClean (tmp_subdirs_to_clean tmpfs) lifetime new_subdirs + +addToClean :: IORef PathsToClean -> TempFileLifetime -> [FilePath] -> IO () +addToClean ref lifetime new_filepaths = modifyIORef' ref $ + \PathsToClean + { ptcCurrentModule = cm_paths + , ptcGhcSession = gs_paths } -> case lifetime of - TFL_CurrentModule -> FilesToClean - { ftcCurrentModule = cm_files `Set.union` new_files_set - , ftcGhcSession = gs_files `Set.difference` new_files_set + TFL_CurrentModule -> PathsToClean + { ptcCurrentModule = cm_paths `Set.union` new_filepaths_set + , ptcGhcSession = gs_paths `Set.difference` new_filepaths_set } - TFL_GhcSession -> FilesToClean - { ftcCurrentModule = cm_files `Set.difference` new_files_set - , ftcGhcSession = gs_files `Set.union` new_files_set + TFL_GhcSession -> PathsToClean + { ptcCurrentModule = cm_paths `Set.difference` new_filepaths_set + , ptcGhcSession = gs_paths `Set.union` new_filepaths_set } where - new_files_set = Set.fromList new_files + new_filepaths_set = Set.fromList new_filepaths -- | Update the lifetime of files already being tracked. If any files are -- not being tracked they will be discarded. changeTempFilesLifetime :: TmpFs -> TempFileLifetime -> [FilePath] -> IO () changeTempFilesLifetime tmpfs lifetime files = do - FilesToClean - { ftcCurrentModule = cm_files - , ftcGhcSession = gs_files + PathsToClean + { ptcCurrentModule = cm_paths + , ptcGhcSession = gs_paths } <- readIORef (tmp_files_to_clean tmpfs) let old_set = case lifetime of - TFL_CurrentModule -> gs_files - TFL_GhcSession -> cm_files + TFL_CurrentModule -> gs_paths + TFL_GhcSession -> cm_paths existing_files = [f | f <- files, f `Set.member` old_set] addFilesToClean tmpfs lifetime existing_files @@ -224,20 +252,32 @@ newTempName logger tmpfs tmp_dir lifetime extn addFilesToClean tmpfs lifetime [filename] return filename -newTempDir :: Logger -> TmpFs -> TempDir -> IO FilePath -newTempDir logger tmpfs tmp_dir +-- | Create a new temporary subdirectory that doesn't already exist +-- The temporary subdirectory is automatically removed at the end of the +-- GHC session, but its contents aren't. Make sure to leave the directory +-- empty before the end of the session, either by removing content +-- directly or by using @addFilesToClean at . +-- +-- If the created subdirectory is not empty, it will not be removed (along +-- with its parent temporary directory) and a warning message will be +-- printed at verbosity 2 and higher. +newTempSubDir :: Logger -> TmpFs -> TempDir -> IO FilePath +newTempSubDir logger tmpfs tmp_dir = do d <- getTempDir logger tmpfs tmp_dir findTempDir (d "ghc_") where findTempDir :: FilePath -> IO FilePath findTempDir prefix = do n <- newTempSuffix tmpfs - let filename = prefix ++ show n - b <- doesDirectoryExist filename + let name = prefix ++ show n + b <- doesDirectoryExist name if b then findTempDir prefix - else do createDirectory filename - -- see mkTempDir below; this is wrong: -> consIORef (tmp_dirs_to_clean tmpfs) filename - return filename + else (do + createDirectory name + addSubdirsToClean tmpfs TFL_GhcSession [name] + return name) + `Exception.catchIO` \e -> if isAlreadyExistsError e + then findTempDir prefix else ioError e newTempLibName :: Logger -> TmpFs -> TempDir -> TempFileLifetime -> Suffix -> IO (FilePath, FilePath, String) @@ -338,6 +378,12 @@ removeTmpFiles logger fs (non_deletees, deletees) = partition isHaskellUserSrcFilename fs +removeTmpSubdirs :: Logger -> [FilePath] -> IO () +removeTmpSubdirs logger fs + = traceCmd logger "Deleting temp subdirs" + ("Deleting: " ++ unwords fs) + (mapM_ (removeWith logger removeDirectory) fs) + removeWith :: Logger -> (FilePath -> IO ()) -> FilePath -> IO () removeWith logger remover f = remover f `Exception.catchIO` (\e -> ===================================== rts/js/rts.js ===================================== @@ -365,14 +365,7 @@ function h$printReg(r) { } else if(r.f.t === h$ct_blackhole && r.x) { return ("blackhole: -> " + h$printReg({ f: r.x.x1, d: r.d1.x2 }) + ")"); } else { - var iv = ""; - if(r.f.n === "integer-gmp:GHC.Integer.Type.Jp#" || - r.f.n === "integer-gmp:GHC.Integer.Type.Jn#") { - iv = ' [' + r.d1.join(',') + '](' + h$ghcjsbn_showBase(r.d1, 10) + ')' - } else if(r.f.n === "integer-gmp:GHC.Integer.Type.S#") { - iv = ' (S: ' + r.d1 + ')'; - } - return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")" + iv); + return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")"); } } else if(typeof r === 'object') { var res = h$collectProps(r); @@ -536,14 +529,7 @@ function h$dumpStackTop(stack, start, sp) { if(s.f.t === h$ct_blackhole && s.d1 && s.d1.x1 && s.d1.x1.n) { h$log("stack[" + i + "] = blackhole -> " + s.d1.x1.n); } else { - var iv = ""; - if(s.f.n === "integer-gmp:GHC.Integer.Type.Jp#" || - s.f.n === "integer-gmp:GHC.Integer.Type.Jn#") { - iv = ' [' + s.d1.join(',') + '](' + h$ghcjsbn_showBase(s.d1, 10) + ')' - } else if(s.f.n === "integer-gmp:GHC.Integer.Type.S#") { - iv = ' (S: ' + s.d1 + ')'; - } - h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")" + iv); + h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")"); } } } else if(h$isInstanceOf(s,h$MVar)) { ===================================== testsuite/tests/stranal/should_compile/T22997.hs ===================================== @@ -0,0 +1,9 @@ +module T22997 where + +{-# OPAQUE trivial #-} +trivial :: Int -> Int +trivial = succ + +{-# OPAQUE pap #-} +pap :: Integer -> Integer +pap = (42 +) ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -88,3 +88,5 @@ test('EtaExpansion', normal, compile, ['']) test('T22039', normal, compile, ['']) # T22388: Should see $winteresting but not $wboring test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) +# T22997: Just a panic that should not happen +test('T22997', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T19627.hs ===================================== @@ -0,0 +1,108 @@ +{-# language BlockArguments #-} +{-# language DefaultSignatures #-} +{-# language DerivingStrategies #-} +{-# language EmptyCase #-} +{-# language ExplicitNamespaces #-} +{-# language ImportQualifiedPost #-} +{-# language FlexibleContexts #-} +{-# language FlexibleInstances #-} +{-# language FunctionalDependencies #-} +{-# language GADTs #-} +{-# language LambdaCase #-} +{-# language LinearTypes #-} +{-# language NoStarIsType #-} +{-# language PolyKinds #-} +{-# language QuantifiedConstraints #-} +{-# language RankNTypes #-} +{-# language RoleAnnotations #-} +{-# language ScopedTypeVariables #-} +{-# language StandaloneDeriving #-} +{-# language StandaloneKindSignatures #-} +{-# language StrictData #-} +{-# language TupleSections #-} +{-# language TypeApplications #-} +{-# language TypeFamilies #-} +{-# language TypeFamilyDependencies #-} +{-# language TypeOperators #-} +{-# language UndecidableInstances #-} +{-# language UndecidableSuperClasses #-} + +module T19627 where + +import Data.Kind +import Prelude hiding ( Functor(..) ) + +-------------------- + +class (Prop (Not p), Not (Not p) ~ p) => Prop (p :: Type) where + type Not p :: Type + (!=) :: p -> Not p -> r + +data Y (a :: Type) (b :: Type) (c :: Type) where + L :: Y a b a + R :: Y a b b + +newtype a & b = With (forall c. Y a b c -> c) + +with :: (forall c. Y a b c -> c) -> a & b +with = With + +runWith :: a & b -> Y a b c -> c +runWith (With f) = f + +withL' :: a & b -> a +withL' (With f) = f L + +withR' :: a & b -> b +withR' (With f) = f R + +instance (Prop a, Prop b) => Prop (a & b) where + type Not (a & b) = Not a `Either` Not b + w != Left a = withL' w != a + w != Right b = withR' w != b + +instance (Prop a, Prop b) => Prop (Either a b) where + type Not (Either a b) = Not a & Not b + Left a != w = a != withL' w + Right a != w = a != withR' w + +newtype Yoneda f a = Yoneda + (forall r. Prop r => (a -> r) -> f r) + +data Noneda f a where + Noneda :: Prop r => !(f r <#- (a ⊸ r)) -> Noneda f a + +liftYoneda :: forall f a i. (Functor f, Prop a, Iso i) => i (f a) (Yoneda f a) +liftYoneda = iso \case + L -> lowerYoneda' + R -> lol \case + L -> \(Noneda ((a2r :: a ⊸ r) :-#> nfr)) -> runLol (fmap @f @a @r a2r) L nfr + R -> \fa -> Yoneda do + lol \case + R -> \f -> fmap' f fa + L -> \nfr -> whyNot \a2r -> fmap a2r fa != nfr + + +type family NotApart (p :: Type -> Type -> Type) :: Type -> Type -> Type + +class + ( forall a b. (Prop a, Prop b) => Prop (p a b) + , NotApart (NotIso p) ~ p + ) => Iso p where + type NotIso p = (q :: Type -> Type -> Type) | q -> p + iso :: (forall c. Y (b ⊸ a) (a ⊸ b) c -> c) -> p a b + +data b <#- a where (:-#>) :: a -> Not b -> b <#- a +newtype a ⊸ b = Lol (forall c. Y (Not b %1 -> Not a) (a %1 -> b) c -> c) + +class + ( forall a. Prop a => Prop (f a) + ) => Functor f where + fmap' :: (Prop a, Prop b, Lol l, Lol l') => l ((a ⊸ b)) (l' (f a) (f b)) + +fmap :: forall f a b l. (Functor f, Prop a, Prop b, Lol l) => (a ⊸ b) -> l (f a) (f b) +fmap f = fmap' f + +class Iso p => Lol (p :: Type -> Type -> Type) where + lol :: (forall c. Y (Not b -> Not a) (a -> b) c -> c) -> p a b + apartR :: Not (p a b) -> b <#- a ===================================== testsuite/tests/typecheck/should_fail/T19627.stderr ===================================== @@ -0,0 +1,45 @@ + +T19627.hs:108:3: error: [GHC-05617] + • Could not deduce ‘Not (p0 a b) ~ Not (p a b)’ + from the context: Lol p + bound by the type signature for: + apartR :: forall (p :: * -> * -> *) a b. + Lol p => + Not (p a b) -> b <#- a + at T19627.hs:108:3-34 + Expected: Not (p a b) -> b <#- a + Actual: Not (p0 a b) -> b <#- a + NB: ‘Not’ is a non-injective type family + The type variable ‘p0’ is ambiguous + • In the ambiguity check for ‘apartR’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + When checking the class method: + apartR :: forall (p :: * -> * -> *) a b. + Lol p => + Not (p a b) -> b <#- a + In the class declaration for ‘Lol’ + +T19627.hs:108:3: error: [GHC-05617] + • Could not deduce ‘Not (Not (p0 a1 b1)) ~ p0 a1 b1’ + arising from a superclass required to satisfy ‘Prop (p0 a1 b1)’, + arising from the head of a quantified constraint + arising from a superclass required to satisfy ‘Iso p0’, + arising from a superclass required to satisfy ‘Lol p0’, + arising from a type ambiguity check for + the type signature for ‘apartR’ + from the context: Lol p + bound by the type signature for: + apartR :: forall (p :: * -> * -> *) a b. + Lol p => + Not (p a b) -> b <#- a + at T19627.hs:108:3-34 + or from: (Prop a1, Prop b1) + bound by a quantified context at T19627.hs:108:3-34 + The type variable ‘p0’ is ambiguous + • In the ambiguity check for ‘apartR’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + When checking the class method: + apartR :: forall (p :: * -> * -> *) a b. + Lol p => + Not (p a b) -> b <#- a + In the class declaration for ‘Lol’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -671,3 +671,4 @@ test('T20666a', normal, compile, ['']) # To become compile_fail after migration test('T22924a', normal, compile_fail, ['']) test('T22924b', normal, compile_fail, ['']) test('T22940', normal, compile_fail, ['']) +test('T19627', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ce9e4e731952339cd9a1a52681bc838fb8778edc...32163a1893061a4cd22974cf27280d68c51b2861 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ce9e4e731952339cd9a1a52681bc838fb8778edc...32163a1893061a4cd22974cf27280d68c51b2861 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 14:42:35 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 09:42:35 -0500 Subject: [Git][ghc/ghc][wip/backports-9.6] Fix TBA in base changelog Message-ID: <640b41dbdeadb_36ed6c746caec144591@gitlab.mail> Ben Gamari pushed to branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC Commits: a58c028a by Ben Gamari at 2023-03-10T09:42:25-05:00 Fix TBA in base changelog - - - - - 1 changed file: - libraries/base/changelog.md Changes: ===================================== libraries/base/changelog.md ===================================== @@ -1,6 +1,6 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) -## 4.18.0.0 *TBA* +## 4.18.0.0 *March 2023* * Add `INLINABLE` pragmas to `generic*` functions in Data.OldList ([CLC proposal #129](https://github.com/haskell/core-libraries-committee/issues/130)) * `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a58c028a181106312e1a783e82a37fc657ce9cfe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a58c028a181106312e1a783e82a37fc657ce9cfe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 15:06:17 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 10 Mar 2023 10:06:17 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/cheaper-eta Message-ID: <640b476959e81_36ed6c783003414874a@gitlab.mail> Sebastian Graf pushed new branch wip/cheaper-eta at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/cheaper-eta You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 15:19:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Mar 2023 10:19:11 -0500 Subject: [Git][ghc/ghc][master] DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) Message-ID: <640b4a6f7649_36ed6c7d1add81571ef@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 3 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - + testsuite/tests/stranal/should_compile/T22997.hs - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1916,10 +1916,11 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- Check for an OPAQUE function: see Note [OPAQUE pragma] -- In that case, trim off all boxity info from argument demands + -- and demand info on lambda binders -- See Note [The OPAQUE pragma and avoiding the reboxing of arguments] | isOpaquePragma (idInlinePragma fn) , let trimmed_rhs_dmds = map trimBoxity rhs_dmds - = (trimmed_rhs_dmds, add_demands trimmed_rhs_dmds rhs) + = (trimmed_rhs_dmds, set_lam_dmds trimmed_rhs_dmds rhs) -- Check that we have enough visible binders to match the -- threshold arity; if not, we won't do worker/wrapper @@ -1939,8 +1940,8 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- vcat [text "function:" <+> ppr fn -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ - (arg_dmds', add_demands arg_dmds' rhs) - -- add_demands: we must attach the final boxities to the lambda-binders + (arg_dmds', set_lam_dmds arg_dmds' rhs) + -- set_lam_dmds: we must attach the final boxities to the lambda-binders -- of the function, both because that's kosher, and because CPR analysis -- uses the info on the binders directly. where @@ -2032,17 +2033,18 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs | positiveTopBudget bg_inner' = (bg_inner', dmd') | otherwise = (bg_inner, trimBoxity dmd) - add_demands :: [Demand] -> CoreExpr -> CoreExpr + set_lam_dmds :: [Demand] -> CoreExpr -> CoreExpr -- Attach the demands to the outer lambdas of this expression - add_demands [] e = e - add_demands (dmd:dmds) (Lam v e) - | isTyVar v = Lam v (add_demands (dmd:dmds) e) - | otherwise = Lam (v `setIdDemandInfo` dmd) (add_demands dmds e) - add_demands dmds (Cast e co) = Cast (add_demands dmds e) co + set_lam_dmds (dmd:dmds) (Lam v e) + | isTyVar v = Lam v (set_lam_dmds (dmd:dmds) e) + | otherwise = Lam (v `setIdDemandInfo` dmd) (set_lam_dmds dmds e) + set_lam_dmds dmds (Cast e co) = Cast (set_lam_dmds dmds e) co -- This case happens for an OPAQUE function, which may look like -- f = (\x y. blah) |> co -- We give it strictness but no boxity (#22502) - add_demands dmds e = pprPanic "add_demands" (ppr dmds $$ ppr e) + set_lam_dmds _ e = e + -- In the OPAQUE case, the list of demands at this point might be + -- non-empty, e.g., when looking at a PAP. Hence don't panic (#22997). finaliseLetBoxity :: AnalEnv ===================================== testsuite/tests/stranal/should_compile/T22997.hs ===================================== @@ -0,0 +1,9 @@ +module T22997 where + +{-# OPAQUE trivial #-} +trivial :: Int -> Int +trivial = succ + +{-# OPAQUE pap #-} +pap :: Integer -> Integer +pap = (42 +) ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -88,3 +88,5 @@ test('EtaExpansion', normal, compile, ['']) test('T22039', normal, compile, ['']) # T22388: Should see $winteresting but not $wboring test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) +# T22997: Just a panic that should not happen +test('T22997', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec2d93ebf2468e9250676da256936d8940de4723 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec2d93ebf2468e9250676da256936d8940de4723 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 15:19:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Mar 2023 10:19:51 -0500 Subject: [Git][ghc/ghc][master] JS: remove dead code for old integer-gmp Message-ID: <640b4a97bd59b_36ed6c7f90f18160213@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - 1 changed file: - rts/js/rts.js Changes: ===================================== rts/js/rts.js ===================================== @@ -365,14 +365,7 @@ function h$printReg(r) { } else if(r.f.t === h$ct_blackhole && r.x) { return ("blackhole: -> " + h$printReg({ f: r.x.x1, d: r.d1.x2 }) + ")"); } else { - var iv = ""; - if(r.f.n === "integer-gmp:GHC.Integer.Type.Jp#" || - r.f.n === "integer-gmp:GHC.Integer.Type.Jn#") { - iv = ' [' + r.d1.join(',') + '](' + h$ghcjsbn_showBase(r.d1, 10) + ')' - } else if(r.f.n === "integer-gmp:GHC.Integer.Type.S#") { - iv = ' (S: ' + r.d1 + ')'; - } - return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")" + iv); + return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")"); } } else if(typeof r === 'object') { var res = h$collectProps(r); @@ -536,14 +529,7 @@ function h$dumpStackTop(stack, start, sp) { if(s.f.t === h$ct_blackhole && s.d1 && s.d1.x1 && s.d1.x1.n) { h$log("stack[" + i + "] = blackhole -> " + s.d1.x1.n); } else { - var iv = ""; - if(s.f.n === "integer-gmp:GHC.Integer.Type.Jp#" || - s.f.n === "integer-gmp:GHC.Integer.Type.Jn#") { - iv = ' [' + s.d1.join(',') + '](' + h$ghcjsbn_showBase(s.d1, 10) + ')' - } else if(s.f.n === "integer-gmp:GHC.Integer.Type.S#") { - iv = ' (S: ' + s.d1 + ')'; - } - h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")" + iv); + h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")"); } } } else if(h$isInstanceOf(s,h$MVar)) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b4628aeeca9b7ae0665378f0ce1b1d967c6a1c9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b4628aeeca9b7ae0665378f0ce1b1d967c6a1c9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 16:16:13 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Fri, 10 Mar 2023 11:16:13 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/js-forceBool Message-ID: <640b57cdc8407_36ed6c90eebc017309c@gitlab.mail> Josh Meredith pushed new branch wip/js-forceBool at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-forceBool You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 16:18:57 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 11:18:57 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T13660 Message-ID: <640b587123c63_36ed6c94305901750f6@gitlab.mail> Ben Gamari pushed new branch wip/T13660 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T13660 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 16:31:29 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 11:31:29 -0500 Subject: [Git][ghc/ghc][wip/T13660] 2 commits: base: Ensure that FilePaths don't contain NULs on POSIX Message-ID: <640b5b6135d4d_36ed6c96ed4cc18467a@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 9198e7fe by Ben Gamari at 2023-03-10T11:31:25-05:00 base: Ensure that FilePaths don't contain NULs on POSIX POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. Fixes #13660. - - - - - f3cc8aa5 by Ben Gamari at 2023-03-10T11:31:25-05:00 base: Add test for #13660 - - - - - 3 changed files: - libraries/base/System/Posix/Internals.hs - + libraries/base/tests/T13660.hs - libraries/base/tests/all.T Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -178,11 +178,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are disallowed +-- in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = go (len-1) + where + -- here we ensure that the body of the string (that is, excluding the terminal + -- NUL) contains no NUL octets. + go (-1) = return () + go i = do + c <- peekByteOff str i :: IO Word8 + when (c == 0) $ do + ioError err + go (i-1) + + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "POSIX filepaths must not contain internal NUL octets." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + #endif -- --------------------------------------------------------------------------- ===================================== libraries/base/tests/T13660.hs ===================================== @@ -0,0 +1,9 @@ +-- | This should print an InvalidArgument error complaining that +-- the file path contains a NUL octet. +module Main where + +main :: IO () +main = do + catchIOError + (writeFile "hello\x00world" "hello") + print ===================================== libraries/base/tests/all.T ===================================== @@ -256,6 +256,7 @@ test('T13191', ['-O']) test('T13525', [when(opsys('mingw32'), skip), js_broken(22374)], compile_and_run, ['']) test('T13097', normal, compile_and_run, ['']) +test('T13660', when(opsys('mingw32'), skip), compile_and_run, ['']) test('functorOperators', normal, compile_and_run, ['']) test('T3474', [collect_stats('max_bytes_used',5), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4a662ff72d00c28ef9453ed78c9b608ed85d729...f3cc8aa5accf17ea45ca4eba98cf2054330e6edf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4a662ff72d00c28ef9453ed78c9b608ed85d729...f3cc8aa5accf17ea45ca4eba98cf2054330e6edf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 16:32:08 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 11:32:08 -0500 Subject: [Git][ghc/ghc][wip/T13660] 2 commits: base: Add test for #13660 Message-ID: <640b5b88d1e35_36ed6c99ce9701850c7@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: fc80360d by Ben Gamari at 2023-03-10T11:32:02-05:00 base: Add test for #13660 - - - - - 0bfbb397 by Ben Gamari at 2023-03-10T11:32:02-05:00 base: Ensure that FilePaths don't contain NULs on POSIX POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. Fixes #13660. - - - - - 3 changed files: - libraries/base/System/Posix/Internals.hs - + libraries/base/tests/T13660.hs - libraries/base/tests/all.T Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -178,11 +178,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are disallowed +-- in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = go (len-1) + where + -- here we ensure that the body of the string (that is, excluding the terminal + -- NUL) contains no NUL octets. + go i | i < 0 = return () + go i = do + c <- peekByteOff str i :: IO Word8 + when (c == 0) $ do + ioError err + go (i-1) + + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "POSIX filepaths must not contain internal NUL octets." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + #endif -- --------------------------------------------------------------------------- ===================================== libraries/base/tests/T13660.hs ===================================== @@ -0,0 +1,9 @@ +-- | This should print an InvalidArgument error complaining that +-- the file path contains a NUL octet. +module Main where + +main :: IO () +main = do + catchIOError + (writeFile "hello\x00world" "hello") + print ===================================== libraries/base/tests/all.T ===================================== @@ -256,6 +256,7 @@ test('T13191', ['-O']) test('T13525', [when(opsys('mingw32'), skip), js_broken(22374)], compile_and_run, ['']) test('T13097', normal, compile_and_run, ['']) +test('T13660', when(opsys('mingw32'), skip), compile_and_run, ['']) test('functorOperators', normal, compile_and_run, ['']) test('T3474', [collect_stats('max_bytes_used',5), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f3cc8aa5accf17ea45ca4eba98cf2054330e6edf...0bfbb3971a0ab203587a1929c36a08c1559dbfcd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f3cc8aa5accf17ea45ca4eba98cf2054330e6edf...0bfbb3971a0ab203587a1929c36a08c1559dbfcd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 16:32:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 11:32:46 -0500 Subject: [Git][ghc/ghc][wip/T13660] base: Ensure that FilePaths don't contain NULs on POSIX Message-ID: <640b5bae89518_36ed6c99ce9701854d6@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 2c965958 by Ben Gamari at 2023-03-10T11:32:40-05:00 base: Ensure that FilePaths don't contain NULs on POSIX POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. Fixes #13660. - - - - - 1 changed file: - libraries/base/System/Posix/Internals.hs Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -178,11 +178,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are disallowed +-- in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = go (len-2) + where + -- here we ensure that the body of the string (that is, excluding the terminal + -- NUL) contains no NUL octets. + go i | i < 0 = return () + go i = do + c <- peekByteOff str i :: IO Word8 + when (c == 0) $ do + ioError err + go (i-1) + + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "POSIX filepaths must not contain internal NUL octets." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + #endif -- --------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c9659587b022e6bfdcc89afcb316ee666673280 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c9659587b022e6bfdcc89afcb316ee666673280 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 16:32:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 11:32:58 -0500 Subject: [Git][ghc/ghc][wip/T13660] base: Ensure that FilePaths don't contain NULs on POSIX Message-ID: <640b5bbae0f84_36ed6c96ef3801858c0@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 02bd2759 by Ben Gamari at 2023-03-10T11:32:53-05:00 base: Ensure that FilePaths don't contain NULs on POSIX POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. Fixes #13660. - - - - - 1 changed file: - libraries/base/System/Posix/Internals.hs Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -178,11 +178,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are disallowed +-- in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = go (len-1) + where + -- here we ensure that the body of the string (that is, excluding the terminal + -- NUL) contains no NUL octets. + go i | i < 0 = return () + go i = do + c <- peekByteOff str i :: IO Word8 + when (c == 0) $ do + ioError err + go (i-1) + + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "POSIX filepaths must not contain internal NUL octets." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + #endif -- --------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02bd275988328759268c3fcfb9f21397bc62f9f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02bd275988328759268c3fcfb9f21397bc62f9f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 16:35:54 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 11:35:54 -0500 Subject: [Git][ghc/ghc][wip/T13660] base: Ensure that FilePaths don't contain NULs on POSIX Message-ID: <640b5c6a9081_36ed6c96f31c418628@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: c543fed5 by Ben Gamari at 2023-03-10T11:35:47-05:00 base: Ensure that FilePaths don't contain NULs on POSIX POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. Fixes #13660. - - - - - 1 changed file: - libraries/base/System/Posix/Internals.hs Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -178,11 +178,44 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = go (len-1) + where + -- Here we walk backwards through the encoded path, ensuring that the body + -- of the string (that is, excluding the terminal NUL) contains no NUL + -- octets. + go i | i < 0 = return () + go i = do + c <- peekByteOff str i :: IO Word8 + when (c == 0) $ do + ioError err + go (i-1) + + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "POSIX filepaths must not contain internal NUL octets." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + #endif -- --------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c543fed5b468d20d5757fe621f2e44dd01a09ab8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c543fed5b468d20d5757fe621f2e44dd01a09ab8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 16:39:19 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Fri, 10 Mar 2023 11:39:19 -0500 Subject: [Git][ghc/ghc][wip/t21766] 68 commits: rts: Drop redundant prototype Message-ID: <640b5d3783e58_36ed6c9e6590c1912d5@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - 9f2af97a by Finley McIlwaine at 2023-03-10T09:34:12-07:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 9ad2b569 by Finley McIlwaine at 2023-03-10T09:34:12-07:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - 246c81d1 by Finley McIlwaine at 2023-03-10T09:34:12-07:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 95192e05 by Finley McIlwaine at 2023-03-10T09:34:12-07:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 38376a48 by Finley McIlwaine at 2023-03-10T09:34:12-07:00 Add note describing IPE data compression See ticket #21766 - - - - - 7d73cad2 by Finley McIlwaine at 2023-03-10T09:34:12-07:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 5137000d by Finley McIlwaine at 2023-03-10T09:34:12-07:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - 54593f47 by Finley McIlwaine at 2023-03-10T09:34:12-07:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 6378f84b by Finley McIlwaine at 2023-03-10T09:36:56-07:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 894685c2 by Finley McIlwaine at 2023-03-10T09:36:59-07:00 Update user's guide and release notes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. See ticket #21766 - - - - - 770beeea by Finley McIlwaine at 2023-03-10T09:37:00-07:00 Fix multiline string in `IPE.c` - - - - - ac20c0ee by Finley McIlwaine at 2023-03-10T09:37:00-07:00 Optional static linking of libzstd Allow for libzstd to be statically linked with a `--enable-static-libzstd` configure flag. Not supported on darwin due to incompatibility with `:x.a` linker flags. - - - - - ba2c1d8b by Finley McIlwaine at 2023-03-10T09:37:00-07:00 Detect darwin for `--enable-static-libzstd` Update users guide to note the optional static linking of libzstd, and update ci-images rev to get libzstd in debian images on CI - - - - - 9948f26a by Finley McIlwaine at 2023-03-10T09:38:07-07:00 Revert `+ipe` enabled CI jobs for ~IPE label - - - - - 2ac6b704 by Finley McIlwaine at 2023-03-10T09:39:00-07:00 Use correct image for wasm jobs in CI - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Utils/TmpFs.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - hadrian/cfg/system.config.in - hadrian/doc/user-settings.md - hadrian/src/Expression.hs - hadrian/src/Flavour.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Flavour.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Quick.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-heap/tests/all.T - m4/fp_find_libnuma.m4 - + m4/fp_find_libzstd.m4 - rts/Capability.c - rts/Capability.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a8095948fdfb562f6802869a506eb4cd572ab43...2ac6b704de7b7120af3ebc5aa45636b493f26fd6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a8095948fdfb562f6802869a506eb4cd572ab43...2ac6b704de7b7120af3ebc5aa45636b493f26fd6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 16:40:29 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Fri, 10 Mar 2023 11:40:29 -0500 Subject: [Git][ghc/ghc][wip/t21766] Use correct image for wasm jobs in CI Message-ID: <640b5d7db3322_36ed6c9f141dc191823@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: 1bed0580 by Finley McIlwaine at 2023-03-10T09:39:45-07:00 Use correct image for wasm jobs in CI - - - - - 2 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -133,22 +133,23 @@ data CrossEmulator -- | A BuildConfig records all the options which can be modified to affect the -- bindists produced by the compiler. data BuildConfig - = BuildConfig { withDwarf :: Bool - , unregisterised :: Bool - , buildFlavour :: BaseFlavour - , bignumBackend :: BignumBackend - , llvmBootstrap :: Bool - , withAssertions :: Bool - , withNuma :: Bool - , withZstd :: Bool - , crossTarget :: Maybe String - , crossEmulator :: CrossEmulator - , configureWrapper :: Maybe String - , fullyStatic :: Bool - , tablesNextToCode :: Bool - , threadSanitiser :: Bool - , noSplitSections :: Bool + = BuildConfig { withDwarf :: Bool + , unregisterised :: Bool + , buildFlavour :: BaseFlavour + , bignumBackend :: BignumBackend + , llvmBootstrap :: Bool + , withAssertions :: Bool + , withNuma :: Bool + , withZstd :: Bool + , crossTarget :: Maybe String + , crossEmulator :: CrossEmulator + , configureWrapper :: Maybe String + , fullyStatic :: Bool + , tablesNextToCode :: Bool + , threadSanitiser :: Bool + , noSplitSections :: Bool , validateNonmovingGc :: Bool + , isWasm :: Bool } -- Extra arguments to pass to ./configure due to the BuildConfig @@ -206,6 +207,7 @@ vanilla = BuildConfig , threadSanitiser = False , noSplitSections = False , validateNonmovingGc = False + , isWasm = False } splitSectionsBroken :: BuildConfig -> BuildConfig @@ -282,10 +284,10 @@ tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use -- These names are used to find the docker image so they have to match what is -- in the docker registry. distroName :: LinuxDistro -> String -distroName Debian11 = "deb11" +distroName Debian11 = "deb11" distroName Debian10 = "deb10" -distroName Debian9 = "deb9" -distroName Fedora33 = "fedora33" +distroName Debian9 = "deb9" +distroName Fedora33 = "fedora33" distroName Ubuntu1804 = "ubuntu18_04" distroName Ubuntu2004 = "ubuntu20_04" distroName Centos7 = "centos7" @@ -294,14 +296,14 @@ distroName Rocky8 = "rocky8" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro -opsysName Darwin = "darwin" +opsysName Darwin = "darwin" opsysName FreeBSD13 = "freebsd13" -opsysName Windows = "windows" +opsysName Windows = "windows" archName :: Arch -> String -archName Amd64 = "x86_64" +archName Amd64 = "x86_64" archName AArch64 = "aarch64" -archName I386 = "i386" +archName I386 = "i386" binDistName :: Arch -> Opsys -> BuildConfig -> String binDistName arch opsys bc = "ghc-" ++ testEnv arch opsys bc @@ -336,8 +338,8 @@ flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . f flavour_string BootNonmovingGc = "boot_nonmoving_gc" -- The path to the docker image (just for linux builders) -dockerImage :: Arch -> Opsys -> Maybe String -dockerImage arch (Linux distro) = +dockerImage :: Arch -> Opsys -> Bool -> Maybe String +dockerImage arch (Linux distro) isWasm = Just image where image = mconcat @@ -345,9 +347,10 @@ dockerImage arch (Linux distro) = , archName arch , "-linux-" , distroName distro + , if isWasm then "-wasm" else "" , ":$DOCKER_REV" ] -dockerImage _ _ = Nothing +dockerImage _ _ _ = Nothing ----------------------------------------------------------------------------- -- Platform specific variables @@ -650,7 +653,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } jobTags = tags arch opsys buildConfig - jobDockerImage = dockerImage arch opsys + jobDockerImage = dockerImage arch opsys (isWasm buildConfig) jobScript | Windows <- opsys @@ -950,7 +953,8 @@ job_groups = (crossConfig "wasm32-wasi" NoEmulatorNeeded Nothing) { fullyStatic = True - , buildFlavour = Release -- TODO: This needs to be validate but wasm backend doesn't pass yet + , buildFlavour = Release -- TODO: This needs to be validate but wasm backend doesn't pass yet + , isWasm = True } ===================================== .gitlab/jobs.yaml ===================================== @@ -35,7 +35,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -97,7 +97,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -155,7 +155,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -213,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -276,7 +276,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -335,7 +335,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -394,7 +394,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -453,7 +453,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -518,7 +518,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -570,7 +570,7 @@ ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12-wasm:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -579,7 +579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -631,7 +631,7 @@ ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12-wasm:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -640,7 +640,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -701,7 +701,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -755,7 +755,7 @@ ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12-wasm:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -764,7 +764,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -825,7 +825,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -888,7 +888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -948,7 +948,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1007,7 +1007,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1066,7 +1066,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1126,7 +1126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1185,7 +1185,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1244,7 +1244,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1303,7 +1303,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1362,7 +1362,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1423,7 +1423,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1484,7 +1484,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1546,7 +1546,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1605,7 +1605,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1665,7 +1665,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1724,7 +1724,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1785,7 +1785,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1847,7 +1847,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1908,7 +1908,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1968,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2027,7 +2027,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2082,7 +2082,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2141,7 +2141,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2204,7 +2204,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2268,7 +2268,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2328,7 +2328,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2388,7 +2388,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2454,7 +2454,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2518,7 +2518,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2582,7 +2582,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2643,7 +2643,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2703,7 +2703,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2763,7 +2763,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2823,7 +2823,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2884,7 +2884,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2944,7 +2944,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3006,7 +3006,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3068,7 +3068,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3131,7 +3131,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3192,7 +3192,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3252,7 +3252,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3308,7 +3308,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3368,7 +3368,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3432,7 +3432,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3496,7 +3496,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3547,7 +3547,7 @@ ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12-wasm:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -3556,7 +3556,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3616,7 +3616,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3678,7 +3678,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3737,7 +3737,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3795,7 +3795,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3854,7 +3854,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3912,7 +3912,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3970,7 +3970,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4028,7 +4028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4087,7 +4087,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4147,7 +4147,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4207,7 +4207,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4268,7 +4268,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4327,7 +4327,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4383,7 +4383,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1bed0580e3d6ff19b3e1627232b689aca09c0a4a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1bed0580e3d6ff19b3e1627232b689aca09c0a4a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 17:04:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 12:04:45 -0500 Subject: [Git][ghc/ghc][wip/T13660] 2 commits: base: Ensure that FilePaths don't contain NULs on POSIX Message-ID: <640b632d63dfc_36ed6ca42d290196484@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 470e3d57 by Ben Gamari at 2023-03-10T12:04:35-05:00 base: Ensure that FilePaths don't contain NULs on POSIX POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. Fixes #13660 on POSIX platforms. - - - - - e316cbba by Ben Gamari at 2023-03-10T12:04:40-05:00 base: Reject NUL codepoints in Windows FilePaths Similarly to POSIX, Windows rejects NULs in FilePaths. Unlike POSIX, we can check the `FilePath` rather than its encoding since all paths are UTF-16 on Windows. Fixes #13660 on Windows. - - - - - 1 changed file: - libraries/base/System/Posix/Internals.hs Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -164,13 +164,35 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls = mapM_ f + where + f '\0' = ioError err + f _ = return () + + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "Windows filepaths must not contain internal NUL codepoints." + , ioe_errno = Nothing + , ioe_filename = Just fp + } #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,11 +200,44 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = go (len-1) + where + -- Here we walk backwards through the encoded path, ensuring that the body + -- of the string (that is, excluding the terminal NUL) contains no NUL + -- octets. + go i | i < 0 = return () + go i = do + c <- peekByteOff str i :: IO Word8 + when (c == 0) $ do + ioError err + go (i-1) + + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "POSIX filepaths must not contain internal NUL octets." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + #endif -- --------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c543fed5b468d20d5757fe621f2e44dd01a09ab8...e316cbba1e70ce1974498e2a48f89212b814d33d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c543fed5b468d20d5757fe621f2e44dd01a09ab8...e316cbba1e70ce1974498e2a48f89212b814d33d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 17:26:57 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 10 Mar 2023 12:26:57 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/T23102 Message-ID: <640b68613ba01_36ed6cad73070201878@gitlab.mail> Sebastian Graf pushed new branch wip/T23102 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23102 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 17:36:22 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 10 Mar 2023 12:36:22 -0500 Subject: [Git][ghc/ghc][wip/T23083] 89 commits: Don't suppress *all* Wanteds Message-ID: <640b6a96e92bc_36ed6cb080ec020548b@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - 372ea02e by Sebastian Graf at 2023-03-10T18:26:17+01:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. - - - - - 8ca0c05b by Sebastian Graf at 2023-03-10T18:26:17+01:00 Simplifier: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` Tweaking the Simplifier to eta-expand in args was a bit more painful than expected: * `tryEtaExpandRhs` and `findRhsArity` previously only worked on bindings. But eta expansion of non-recursive bindings is morally the same as eta expansion of arguments. And in fact the binder was never really looked at in the non-recursive case. I was able to make `findRhsArity` cater for both arguments and bindings, as well as have a new function `tryEtaExpandArg` that shares most of its code with that of `tryEtaExpandRhs`. * The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`, which seems to be the main way to simplify args. Hence I consolidated the code path to call `simplArg`, too, renaming to `simplLazyArg`. Fixes #23083. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Stats.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d81cad21a5a05b06d3a2413fc7400eba2548cbd6...8ca0c05b598353177cec46d4a508ea725d282f09 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d81cad21a5a05b06d3a2413fc7400eba2548cbd6...8ca0c05b598353177cec46d4a508ea725d282f09 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 17:43:17 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 10 Mar 2023 12:43:17 -0500 Subject: [Git][ghc/ghc][wip/T20749] 90 commits: Don't suppress *all* Wanteds Message-ID: <640b6c35cdd8e_36ed6cb35443021095@gitlab.mail> Sebastian Graf pushed to branch wip/T20749 at Glasgow Haskell Compiler / GHC Commits: 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - 372ea02e by Sebastian Graf at 2023-03-10T18:26:17+01:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. - - - - - 8ca0c05b by Sebastian Graf at 2023-03-10T18:26:17+01:00 Simplifier: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` Tweaking the Simplifier to eta-expand in args was a bit more painful than expected: * `tryEtaExpandRhs` and `findRhsArity` previously only worked on bindings. But eta expansion of non-recursive bindings is morally the same as eta expansion of arguments. And in fact the binder was never really looked at in the non-recursive case. I was able to make `findRhsArity` cater for both arguments and bindings, as well as have a new function `tryEtaExpandArg` that shares most of its code with that of `tryEtaExpandRhs`. * The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`, which seems to be the main way to simplify args. Hence I consolidated the code path to call `simplArg`, too, renaming to `simplLazyArg`. Fixes #23083. - - - - - c870da6a by Sebastian Graf at 2023-03-10T18:43:00+01:00 Make DataCon workers strict in strict fields (#20749) This patch tweaks `exprIsConApp_maybe`, `exprIsHNF` and friends, and Demand Analysis so that they exploit and maintain strictness of DataCon workers. See `Note [Strict fields in Core]` for details. Very little needed to change, and it puts field seq insertion done by Tag Inference into a new perspective: That of *implementing* strict field semantics. Before Tag Inference, DataCon workers are strict. Afterwards they are effectively lazy and field seqs happen around use sites. History has shown that there is no other way to guarantee taggedness and thus the STG Strict Field Invariant. Knock-on changes: * `exprIsHNF` previously used `exprOkForSpeculation` on unlifted arguments instead of recursing into `exprIsHNF`. That regressed the termination analysis in CPR analysis (which simply calls out to `exprIsHNF`), so I made it call `exprOkForSpeculation`, too. * There's a small regression in Demand Analysis, visible in the changed test output of T16859: Previously, a field seq on a variable would give that variable a "used exactly once" demand, now it's "used at least once", because `dmdTransformDataConSig` accounts for future uses of the field that actually all go through the case binder (and hence won't re-enter the potential thunk). The difference should hardly be observable. * The Simplifier's fast path for data constructors only applies to lazy data constructors now. I observed regressions involving Data.Binary.Put's `Pair` data type. * Unfortunately, T21392 does no longer reproduce after this patch, so I marked it as "not broken" in order to track whether we regress again in the future. Fixes #20749, the satisfying conclusion of an annoying saga (cf. the ideas in #21497 and #22475). - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Stats.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Stg/InferTags.hs - compiler/GHC/Stg/InferTags/Rewrite.hs - compiler/GHC/StgToByteCode.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/beb2ed53d13d8c0d662c2bef182a9cfe490a6448...c870da6a6309282b829748c9ac8bed72f295f1af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/beb2ed53d13d8c0d662c2bef182a9cfe490a6448...c870da6a6309282b829748c9ac8bed72f295f1af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 18:53:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Mar 2023 13:53:01 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) Message-ID: <640b7c8d80d0_36ed6cc858ef82289aa@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - dbe1f848 by Josh Meredith at 2023-03-10T13:52:55-05:00 JS: Fix implementation of MK_JSVAL - - - - - 298f6994 by Sebastian Graf at 2023-03-10T13:52:55-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 6 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/StgToJS/Linker/Utils.hs - rts/js/rts.js - + testsuite/tests/stranal/should_compile/T22997.hs - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1916,10 +1916,11 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- Check for an OPAQUE function: see Note [OPAQUE pragma] -- In that case, trim off all boxity info from argument demands + -- and demand info on lambda binders -- See Note [The OPAQUE pragma and avoiding the reboxing of arguments] | isOpaquePragma (idInlinePragma fn) , let trimmed_rhs_dmds = map trimBoxity rhs_dmds - = (trimmed_rhs_dmds, add_demands trimmed_rhs_dmds rhs) + = (trimmed_rhs_dmds, set_lam_dmds trimmed_rhs_dmds rhs) -- Check that we have enough visible binders to match the -- threshold arity; if not, we won't do worker/wrapper @@ -1939,8 +1940,8 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- vcat [text "function:" <+> ppr fn -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ - (arg_dmds', add_demands arg_dmds' rhs) - -- add_demands: we must attach the final boxities to the lambda-binders + (arg_dmds', set_lam_dmds arg_dmds' rhs) + -- set_lam_dmds: we must attach the final boxities to the lambda-binders -- of the function, both because that's kosher, and because CPR analysis -- uses the info on the binders directly. where @@ -2032,17 +2033,18 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs | positiveTopBudget bg_inner' = (bg_inner', dmd') | otherwise = (bg_inner, trimBoxity dmd) - add_demands :: [Demand] -> CoreExpr -> CoreExpr + set_lam_dmds :: [Demand] -> CoreExpr -> CoreExpr -- Attach the demands to the outer lambdas of this expression - add_demands [] e = e - add_demands (dmd:dmds) (Lam v e) - | isTyVar v = Lam v (add_demands (dmd:dmds) e) - | otherwise = Lam (v `setIdDemandInfo` dmd) (add_demands dmds e) - add_demands dmds (Cast e co) = Cast (add_demands dmds e) co + set_lam_dmds (dmd:dmds) (Lam v e) + | isTyVar v = Lam v (set_lam_dmds (dmd:dmds) e) + | otherwise = Lam (v `setIdDemandInfo` dmd) (set_lam_dmds dmds e) + set_lam_dmds dmds (Cast e co) = Cast (set_lam_dmds dmds e) co -- This case happens for an OPAQUE function, which may look like -- f = (\x y. blah) |> co -- We give it strictness but no boxity (#22502) - add_demands dmds e = pprPanic "add_demands" (ppr dmds $$ ppr e) + set_lam_dmds _ e = e + -- In the OPAQUE case, the list of demands at this point might be + -- non-empty, e.g., when looking at a PAP. Hence don't panic (#22997). finaliseLetBoxity :: AnalEnv ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1859,11 +1859,12 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpandRhs env bind_cxt bndr rhs - | do_eta_expand -- If the current manifest arity isn't enough - -- (never true for join points) - , seEtaExpand env -- and eta-expansion is on - , wantEtaExpansion rhs - = -- Do eta-expansion. + | seEtaExpand env -- If Eta-expansion is on + , wantEtaExpansion rhs -- and we'd like to eta-expand e + , do_eta_expand -- and e's manifest arity is lower than + -- what it could be + -- (never true for join points) + = -- Do eta-expansion. assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ -- assert: this never happens for join points; see GHC.Core.Opt.Arity -- Note [Do not eta-expand join points] ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -115,8 +115,8 @@ genCommonCppDefs profiling = mconcat -- GHCJS.Prim.JSVal , if profiling - then "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)\n" - else "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x))\n" + then "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM))\n" + else "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x)))\n" , "#define JSVAL_VAL(x) ((x).d1)\n" -- GHCJS.Prim.JSException ===================================== rts/js/rts.js ===================================== @@ -365,14 +365,7 @@ function h$printReg(r) { } else if(r.f.t === h$ct_blackhole && r.x) { return ("blackhole: -> " + h$printReg({ f: r.x.x1, d: r.d1.x2 }) + ")"); } else { - var iv = ""; - if(r.f.n === "integer-gmp:GHC.Integer.Type.Jp#" || - r.f.n === "integer-gmp:GHC.Integer.Type.Jn#") { - iv = ' [' + r.d1.join(',') + '](' + h$ghcjsbn_showBase(r.d1, 10) + ')' - } else if(r.f.n === "integer-gmp:GHC.Integer.Type.S#") { - iv = ' (S: ' + r.d1 + ')'; - } - return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")" + iv); + return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")"); } } else if(typeof r === 'object') { var res = h$collectProps(r); @@ -536,14 +529,7 @@ function h$dumpStackTop(stack, start, sp) { if(s.f.t === h$ct_blackhole && s.d1 && s.d1.x1 && s.d1.x1.n) { h$log("stack[" + i + "] = blackhole -> " + s.d1.x1.n); } else { - var iv = ""; - if(s.f.n === "integer-gmp:GHC.Integer.Type.Jp#" || - s.f.n === "integer-gmp:GHC.Integer.Type.Jn#") { - iv = ' [' + s.d1.join(',') + '](' + h$ghcjsbn_showBase(s.d1, 10) + ')' - } else if(s.f.n === "integer-gmp:GHC.Integer.Type.S#") { - iv = ' (S: ' + s.d1 + ')'; - } - h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")" + iv); + h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")"); } } } else if(h$isInstanceOf(s,h$MVar)) { ===================================== testsuite/tests/stranal/should_compile/T22997.hs ===================================== @@ -0,0 +1,9 @@ +module T22997 where + +{-# OPAQUE trivial #-} +trivial :: Int -> Int +trivial = succ + +{-# OPAQUE pap #-} +pap :: Integer -> Integer +pap = (42 +) ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -88,3 +88,5 @@ test('EtaExpansion', normal, compile, ['']) test('T22039', normal, compile, ['']) # T22388: Should see $winteresting but not $wboring test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) +# T22997: Just a panic that should not happen +test('T22997', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32163a1893061a4cd22974cf27280d68c51b2861...298f69943c904803ed5d515af1143cdabdc93285 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32163a1893061a4cd22974cf27280d68c51b2861...298f69943c904803ed5d515af1143cdabdc93285 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 19:57:20 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 14:57:20 -0500 Subject: [Git][ghc/ghc][ghc-9.6] 15 commits: relnotes: Clean up headings Message-ID: <640b8ba05409d_36ed6cd8d5718239032@gitlab.mail> Ben Gamari pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC Commits: 2faa1799 by Ben Gamari at 2023-03-07T17:08:21-05:00 relnotes: Clean up headings Thanks to David Christiansen for noticing this. - - - - - e3a2b2ec by Ben Gamari at 2023-03-09T15:18:46-05:00 Bump Cabal submodule to 3.10 release - - - - - 2d7ca624 by Sylvain Henry at 2023-03-09T15:49:33-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). (cherry picked from commit 4158722a6cff5d19e228356c525946b6c4b83396) - - - - - 4dab7f8c by MorrowM at 2023-03-09T15:50:48-05:00 Fix documentation for traceWith and friends (cherry picked from commit 2aa0770845631e4355f55694f49b3e4b66ecf751) - - - - - 67c80633 by Chris Wendt at 2023-03-09T15:51:03-05:00 Fix typo in docs referring to threadLabel (cherry picked from commit c6e1f3cdcd59e6834820be3c8dc89b66b27b5f57) - - - - - 009e2356 by Ben Gamari at 2023-03-09T15:52:31-05:00 Bump hpc submodule with js backend changes - - - - - 4fc17738 by Ben Gamari at 2023-03-09T15:52:46-05:00 Bump stm submodule with js backend changes - - - - - 1d02aa2a by Ben Gamari at 2023-03-10T02:06:14-05:00 docs/relnotes: Mention fat interface blog post - - - - - 1595174f by Ben Gamari at 2023-03-10T02:06:14-05:00 rel-eng: Fix name of Rocky 8 bindist - - - - - 9706e3de by Ryan Scott at 2023-03-10T02:11:16-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. (cherry picked from commit 4327d63594f73939a2b8ab015c1cb44eafd4b460) - - - - - d81d0a0e by Ryan Scott at 2023-03-10T02:11:16-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. (cherry picked from commit 96dc58b9225d91a7912957c6be5d9c7a95e51718) - - - - - 34172066 by Ryan Scott at 2023-03-10T02:11:16-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. (cherry picked from commit ff8e99f69b203559b784014ab26c59b5553d128a) - - - - - 87ab8e35 by Ben Gamari at 2023-03-10T02:34:36-05:00 Bump haddock submodule to 2.28 - - - - - 1f5bce0d by Ben Gamari at 2023-03-10T02:34:36-05:00 Set RELEASE=YES - - - - - a58c028a by Ben Gamari at 2023-03-10T09:42:25-05:00 Fix TBA in base changelog - - - - - 30 changed files: - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Make.hs - configure.ac - docs/users_guide/9.6.1-notes.rst - libraries/Cabal - libraries/base/Debug/Trace.hs - libraries/base/changelog.md - libraries/hpc - libraries/stm - rts/linker/Elf.c - + testsuite/tests/pmcheck/should_compile/T22964.hs - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/rts/linker/Makefile - + testsuite/tests/rts/linker/T23066.stdout - + testsuite/tests/rts/linker/T23066_c.c - testsuite/tests/rts/linker/all.T - + testsuite/tests/type-data/should_compile/T22948b.hs - + testsuite/tests/type-data/should_compile/T22948b.stderr - testsuite/tests/type-data/should_compile/all.T - + testsuite/tests/type-data/should_fail/TDTagToEnum.hs - + testsuite/tests/type-data/should_fail/TDTagToEnum.stderr - testsuite/tests/type-data/should_fail/all.T - + testsuite/tests/type-data/should_run/T22948a.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fbc98e66077b933b634bf86a8d4a739ef10ea232...a58c028a181106312e1a783e82a37fc657ce9cfe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fbc98e66077b933b634bf86a8d4a739ef10ea232...a58c028a181106312e1a783e82a37fc657ce9cfe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 10 19:57:17 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 10 Mar 2023 14:57:17 -0500 Subject: [Git][ghc/ghc] Deleted branch wip/backports-9.6 Message-ID: <640b8b9dd63d5_36ed6cd8e38a4238868@gitlab.mail> Ben Gamari deleted branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 11 01:14:49 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Mar 2023 20:14:49 -0500 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: JS: Fix implementation of MK_JSVAL Message-ID: <640bd60920fb8_36ed6c12bb0d48263994@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 460d98a3 by Josh Meredith at 2023-03-10T20:14:44-05:00 JS: Fix implementation of MK_JSVAL - - - - - 52713729 by Sebastian Graf at 2023-03-10T20:14:44-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 2 changed files: - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/StgToJS/Linker/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1859,11 +1859,12 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpandRhs env bind_cxt bndr rhs - | do_eta_expand -- If the current manifest arity isn't enough - -- (never true for join points) - , seEtaExpand env -- and eta-expansion is on - , wantEtaExpansion rhs - = -- Do eta-expansion. + | seEtaExpand env -- If Eta-expansion is on + , wantEtaExpansion rhs -- and we'd like to eta-expand e + , do_eta_expand -- and e's manifest arity is lower than + -- what it could be + -- (never true for join points) + = -- Do eta-expansion. assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ -- assert: this never happens for join points; see GHC.Core.Opt.Arity -- Note [Do not eta-expand join points] ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -115,8 +115,8 @@ genCommonCppDefs profiling = mconcat -- GHCJS.Prim.JSVal , if profiling - then "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)\n" - else "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x))\n" + then "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM))\n" + else "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x)))\n" , "#define JSVAL_VAL(x) ((x).d1)\n" -- GHCJS.Prim.JSException View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/298f69943c904803ed5d515af1143cdabdc93285...527137295fdfa11a05680f90cc4770f68acc4030 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/298f69943c904803ed5d515af1143cdabdc93285...527137295fdfa11a05680f90cc4770f68acc4030 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 11 04:25:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Mar 2023 23:25:03 -0500 Subject: [Git][ghc/ghc][master] JS: Fix implementation of MK_JSVAL Message-ID: <640c029fe98c5_36ed6c15cb1d702818f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - 1 changed file: - compiler/GHC/StgToJS/Linker/Utils.hs Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -115,8 +115,8 @@ genCommonCppDefs profiling = mconcat -- GHCJS.Prim.JSVal , if profiling - then "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)\n" - else "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x))\n" + then "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM))\n" + else "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x)))\n" , "#define JSVAL_VAL(x) ((x).d1)\n" -- GHCJS.Prim.JSException View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bab232795865e9abb82b75c7e72329778e23a345 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bab232795865e9abb82b75c7e72329778e23a345 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 11 04:25:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 10 Mar 2023 23:25:39 -0500 Subject: [Git][ghc/ghc][master] Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check Message-ID: <640c02c39f114_36ed6c15ddf8c82851c9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1859,11 +1859,12 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpandRhs env bind_cxt bndr rhs - | do_eta_expand -- If the current manifest arity isn't enough - -- (never true for join points) - , seEtaExpand env -- and eta-expansion is on - , wantEtaExpansion rhs - = -- Do eta-expansion. + | seEtaExpand env -- If Eta-expansion is on + , wantEtaExpansion rhs -- and we'd like to eta-expand e + , do_eta_expand -- and e's manifest arity is lower than + -- what it could be + -- (never true for join points) + = -- Do eta-expansion. assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ -- assert: this never happens for join points; see GHC.Core.Opt.Arity -- Note [Do not eta-expand join points] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec263a59b886ea616dabce349df7a377d5356dd5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec263a59b886ea616dabce349df7a377d5356dd5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 11 09:46:29 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Sat, 11 Mar 2023 04:46:29 -0500 Subject: [Git][ghc/ghc][wip/T23102] Simplifier: `countValArgs` should not count Type args (#23102) Message-ID: <640c4df5d7adc_36ed6c1b1c33e03010bc@gitlab.mail> Sebastian Graf pushed to branch wip/T23102 at Glasgow Haskell Compiler / GHC Commits: 079badf0 by Sebastian Graf at 2023-03-11T10:44:21+01:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -553,7 +553,7 @@ countArgs _ = 0 countValArgs :: SimplCont -> Int -- Count value arguments only -countValArgs (ApplyToTy { sc_cont = cont }) = 1 + countValArgs cont +countValArgs (ApplyToTy { sc_cont = cont }) = countValArgs cont countValArgs (ApplyToVal { sc_cont = cont }) = 1 + countValArgs cont countValArgs (CastIt _ cont) = countValArgs cont countValArgs _ = 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/079badf009115b7d1d2175ec3aaaf01c6803bd4f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/079badf009115b7d1d2175ec3aaaf01c6803bd4f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 11 18:54:22 2023 From: gitlab at gitlab.haskell.org (ase (@adamse)) Date: Sat, 11 Mar 2023 13:54:22 -0500 Subject: [Git][ghc/ghc] Pushed new branch wip/adamse/eventlog-docs Message-ID: <640cce5e43be5_36ed6c237d1568323327@gitlab.mail> ase pushed new branch wip/adamse/eventlog-docs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/adamse/eventlog-docs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 11 21:03:20 2023 From: gitlab at gitlab.haskell.org (ase (@adamse)) Date: Sat, 11 Mar 2023 16:03:20 -0500 Subject: [Git][ghc/ghc][wip/adamse/eventlog-docs] docs: explain the BLOCK_MARKER event Message-ID: <640cec987ae_36ed6c25999088329942@gitlab.mail> ase pushed to branch wip/adamse/eventlog-docs at Glasgow Haskell Compiler / GHC Commits: 70ebd2b7 by Adam Sandberg Ericsson at 2023-03-11T21:03:14+00:00 docs: explain the BLOCK_MARKER event - - - - - 1 changed file: - docs/users_guide/eventlog-formats.rst Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -553,11 +553,12 @@ Tracing events :tag: 18 :length: fixed - :field Word32: size + :field Word32: block size :field Word64: end time in nanoseconds - :field Word16: capability number + :field Word16: capability number, invalid if ``0xffff``. - TODO + Marks a chunk of events. The the events that fit in the next ``block size`` + bytes all belong to the block marker capability. .. event-type:: USER_MSG View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70ebd2b731677194883e20319ce9b66c8a829f91 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70ebd2b731677194883e20319ce9b66c8a829f91 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 11 23:36:47 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 11 Mar 2023 18:36:47 -0500 Subject: [Git][ghc/ghc][wip/exception-context] 687 commits: CoreToStg: purge `DynFlags`. Message-ID: <640d108f2b1ec_36ed6c27f3308c3308c2@gitlab.mail> Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC Commits: ff6f2228 by M Farkas-Dyck at 2022-10-20T16:15:51-04:00 CoreToStg: purge `DynFlags`. - - - - - 1ebd521f by Matthew Pickering at 2022-10-20T16:16:27-04:00 ci: Make fat014 test robust For some reason I implemented this as a makefile test rather than a ghci_script test. Hopefully making it a ghci_script test makes it more robust. Fixes #22313 - - - - - 8cd6f435 by Curran McConnell at 2022-10-21T02:58:01-04:00 remove a no-warn directive from GHC.Cmm.ContFlowOpt This patch is motivated by the desire to remove the {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} directive at the top of GHC.Cmm.ContFlowOpt. (Based on the text in this coding standards doc, I understand it's a goal of the project to remove such directives.) I chose this task because I'm a new contributor to GHC, and it seemed like a good way to get acquainted with the patching process. In order to address the warning that arose when I removed the no-warn directive, I added a case to removeUnreachableBlocksProc to handle the CmmData constructor. Clearly, since this partial function has not been erroring out in the wild, its inputs are always in practice wrapped by the CmmProc constructor. Therefore the CmmData case is handled by a precise panic (which is an improvement over the partial pattern match from before). - - - - - a2af7c4c by Nicolas Trangez at 2022-10-21T02:58:39-04:00 build: get rid of `HAVE_TIME_H` As advertized by `autoreconf`: > All current systems provide time.h; it need not be checked for. Hence, remove the check for it in `configure.ac` and remove conditional inclusion of the header in `HAVE_TIME_H` blocks where applicable. The `time.h` header was being included in various source files without a `HAVE_TIME_H` guard already anyway. - - - - - 25cdc630 by Nicolas Trangez at 2022-10-21T02:58:39-04:00 rts: remove use of `TIME_WITH_SYS_TIME` `autoreconf` will insert an `m4_warning` when the obsolescent `AC_HEADER_TIME` macro is used: > Update your code to rely only on HAVE_SYS_TIME_H, > then remove this warning and the obsolete code below it. > All current systems provide time.h; it need not be checked for. > Not all systems provide sys/time.h, but those that do, all allow > you to include it and time.h simultaneously. Presence of `sys/time.h` was already checked in an earlier `AC_CHECK_HEADERS` invocation, so `AC_HEADER_TIME` can be dropped and guards relying on `TIME_WITH_SYS_TIME` can be reworked to (unconditionally) include `time.h` and include `sys/time.h` based on `HAVE_SYS_TIME_H`. Note the documentation of `AC_HEADER_TIME` in (at least) Autoconf 2.67 says > This macro is obsolescent, as current systems can include both files > when they exist. New programs need not use this macro. - - - - - 1fe7921c by Eric Lindblad at 2022-10-21T02:59:21-04:00 runhaskell - - - - - e3b3986e by David Feuer at 2022-10-21T03:00:00-04:00 Document how to quote certain names with spaces Quoting a name for Template Haskell is a bit tricky if the second character of that name is a single quote. The User's Guide falsely claimed that it was impossible. Document how to do it. Fixes #22236 - - - - - 0eba81e8 by Krzysztof Gogolewski at 2022-10-21T03:00:00-04:00 Fix syntax - - - - - a4dbd102 by Ben Gamari at 2022-10-21T09:11:12-04:00 Fix manifest filename when writing Windows .rc files As noted in #12971, we previously used `show` which resulted in inappropriate escaping of non-ASCII characters. - - - - - 30f0d9a9 by Ben Gamari at 2022-10-21T09:11:12-04:00 Write response files in UTF-8 on Windows This reverts the workaround introduced in f63c8ef33ec9666688163abe4ccf2d6c0428a7e7, which taught our response file logic to write response files with the `latin1` encoding to workaround `gcc`'s lacking Unicode support. This is now no longer necessary (and in fact actively unhelpful) since we rather use Clang. - - - - - b8304648 by M Farkas-Dyck at 2022-10-21T09:11:56-04:00 Scrub some partiality in `GHC.Core.Opt.Simplify.Utils`. - - - - - 09ec7de2 by Teo Camarasu at 2022-10-21T13:23:07-04:00 template-haskell: Improve documentation of strictness annotation types Before it was undocumentated that DecidedLazy can be returned by reifyConStrictness for strict fields. This can happen when a field has an unlifted type or its the single field of a newtype constructor. Fixes #21380 - - - - - 88172069 by M Farkas-Dyck at 2022-10-21T13:23:51-04:00 Delete `eqExpr`, since GHC 9.4 has been released. - - - - - 86e6549e by Ömer Sinan Ağacan at 2022-10-22T07:41:30-04:00 Introduce a standard thunk for allocating strings Currently for a top-level closure in the form hey = unpackCString# x we generate code like this: Main.hey_entry() // [R1] { info_tbls: [(c2T4, label: Main.hey_info rep: HeapRep static { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset c2T4: // global _rqm::P64 = R1; if ((Sp + 8) - 24 < SpLim) (likely: False) goto c2T5; else goto c2T6; c2T5: // global R1 = _rqm::P64; call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8; c2T6: // global (_c2T1::I64) = call "ccall" arg hints: [PtrHint, PtrHint] result hints: [PtrHint] newCAF(BaseReg, _rqm::P64); if (_c2T1::I64 == 0) goto c2T3; else goto c2T2; c2T3: // global call (I64[_rqm::P64])() args: 8, res: 0, upd: 8; c2T2: // global I64[Sp - 16] = stg_bh_upd_frame_info; I64[Sp - 8] = _c2T1::I64; R2 = hey1_r2Gg_bytes; Sp = Sp - 16; call GHC.CString.unpackCString#_info(R2) args: 24, res: 0, upd: 24; } } This code is generated for every string literal. Only difference between top-level closures like this is the argument for the bytes of the string (hey1_r2Gg_bytes in the code above). With this patch we introduce a standard thunk in the RTS, called stg_MK_STRING_info, that does what `unpackCString# x` does, except it gets the bytes address from the payload. Using this, for the closure above, we generate this: Main.hey_closure" { Main.hey_closure: const stg_MK_STRING_info; const 0; // padding for indirectee const 0; // static link const 0; // saved info const hey1_r1Gg_bytes; // the payload } This is much smaller in code. Metric Decrease: T10421 T11195 T12150 T12425 T16577 T18282 T18698a T18698b Co-Authored By: Ben Gamari <ben at well-typed.com> - - - - - 1937016b by Andreas Klebinger at 2022-10-22T07:42:06-04:00 hadrian: Improve error for wrong key/value errors. - - - - - 11fe42d8 by Vladislav Zavialov at 2022-10-23T00:11:50+03:00 Class layout info (#19623) Updates the haddock submodule. - - - - - f0a90c11 by Sven Tennie at 2022-10-24T00:12:51-04:00 Pin used way for test cloneMyStack (#21977) cloneMyStack checks the order of closures on the cloned stack. This may change for different ways. Thus we limit this test to one way (normal). - - - - - 0614e74d by Aaron Allen at 2022-10-24T17:11:21+02:00 Convert Diagnostics in GHC.Tc.Gen.Splice (#20116) Replaces uses of `TcRnUnknownMessage` in `GHC.Tc.Gen.Splice` with structured diagnostics. closes #20116 - - - - - 8d2dbe2d by Andreas Klebinger at 2022-10-24T15:59:41-04:00 Improve stg lint for unboxed sums. It now properly lints cases where sums end up distributed over multiple args after unarise. Fixes #22026. - - - - - 41406da5 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Fix binder-swap bug This patch fixes #21229 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. Test is already in simplCore/should_run/T21229 This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. (This is done in a separate patch.) I also modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs In Simplify.Iteration.addAltUnfoldings I also eliminated a guard Many <- idMult case_bndr because we concluded, in #22123, that it was doing no good. - - - - - 5a997e16 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Make the specialiser handle polymorphic specialisation Ticket #13873 unexpectedly showed that a SPECIALISE pragma made a program run (a lot) slower, because less specialisation took place overall. It turned out that the specialiser was missing opportunities because of quantified type variables. It was quite easy to fix. The story is given in Note [Specialising polymorphic dictionaries] Two other minor fixes in the specialiser * There is no benefit in specialising data constructor /wrappers/. (They can appear overloaded because they are given a dictionary to store in the constructor.) Small guard in canSpecImport. * There was a buglet in the UnspecArg case of specHeader, in the case where there is a dead binder. We need a LitRubbish filler for the specUnfolding stuff. I expanded Note [Drop dead args from specialisations] to explain. There is a 4% increase in compile time for T15164, because we generate more specialised code. This seems OK. Metric Increase: T15164 - - - - - 7f203d00 by Sylvain Henry at 2022-10-25T18:07:43-04:00 Numeric exceptions: replace FFI calls with primops ghc-bignum needs a way to raise numerical exceptions defined in base package. At the time we used FFI calls into primops defined in the RTS. These FFI calls had to be wrapped into hacky bottoming functions because "foreign import prim" syntax doesn't support giving a bottoming demand to the foreign call (cf #16929). These hacky wrapper functions trip up the JavaScript backend (#21078) because they are polymorphic in their return type. This commit replaces them with primops very similar to raise# but raising predefined exceptions. - - - - - 0988a23d by Sylvain Henry at 2022-10-25T18:08:24-04:00 Enable popcount rewrite rule when cross-compiling The comment applies only when host's word size < target's word size. So we can relax the guard. - - - - - a2f53ac8 by Sylvain Henry at 2022-10-25T18:09:05-04:00 Add GHC.SysTools.Cpp module Move doCpp out of the driver to be able to use it in the upcoming JS backend. - - - - - 1fd7f201 by Ben Gamari at 2022-10-25T18:09:42-04:00 llvm-targets: Add datalayouts for big-endian AArch64 targets Fixes #22311. Thanks to @zeldin for the patch. - - - - - f5a486eb by Krzysztof Gogolewski at 2022-10-25T18:10:19-04:00 Cleanup String/FastString conversions Remove unused mkPtrString and isUnderscoreFS. We no longer use mkPtrString since 1d03d8bef96. Remove unnecessary conversions between FastString and String and back. - - - - - f7bfb40c by Ryan Scott at 2022-10-26T00:01:24-04:00 Broaden the in-scope sets for liftEnvSubst and composeTCvSubst This patch fixes two distinct (but closely related) buglets that were uncovered in #22235: * `liftEnvSubst` used an empty in-scope set, which was not wide enough to cover the variables in the range of the substitution. This patch fixes this by populating the in-scope set from the free variables in the range of the substitution. * `composeTCvSubst` applied the first substitution argument to the range of the second substitution argument, but the first substitution's in-scope set was not wide enough to cover the range of the second substutition. We similarly fix this issue in this patch by widening the first substitution's in-scope set before applying it. Fixes #22235. - - - - - 0270cc54 by Vladislav Zavialov at 2022-10-26T00:02:01-04:00 Introduce TcRnWithHsDocContext (#22346) Before this patch, GHC used withHsDocContext to attach an HsDocContext to an error message: addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg) The problem with this approach is that it only works with TcRnUnknownMessage. But could we attach an HsDocContext to a structured error message in a generic way? This patch solves the problem by introducing a new constructor to TcRnMessage: data TcRnMessage where ... TcRnWithHsDocContext :: !HsDocContext -> !TcRnMessage -> TcRnMessage ... - - - - - 9ab31f42 by Sylvain Henry at 2022-10-26T09:32:20+02:00 Testsuite: more precise test options Necessary for newer cross-compiling backends (JS, Wasm) that don't support TH yet. - - - - - f60a1a62 by Vladislav Zavialov at 2022-10-26T12:17:14-04:00 Use TcRnVDQInTermType in noNestedForallsContextsErr (#20115) When faced with VDQ in the type of a term, GHC generates the following error message: Illegal visible, dependent quantification in the type of a term (GHC does not yet support this) Prior to this patch, there were two ways this message could have been generated and represented: 1. with the dedicated constructor TcRnVDQInTermType (see check_type in GHC.Tc.Validity) 2. with the transitional constructor TcRnUnknownMessage (see noNestedForallsContextsErr in GHC.Rename.Utils) Not only this led to duplication of code generating the final SDoc, it also made it tricky to track the origin of the error message. This patch fixes the problem by using TcRnVDQInTermType exclusively. - - - - - 223e159d by Owen Shepherd at 2022-10-27T13:54:33-04:00 Remove source location information from interface files This change aims to minimize source location information leaking into interface files, which makes ABI hashes dependent on the build location. The `Binary (Located a)` instance has been removed completely. It seems that the HIE interface still needs the ability to serialize SrcSpans, but by wrapping the instances, it should be a lot more difficult to inadvertently add source location information. - - - - - 22e3deb9 by Simon Peyton Jones at 2022-10-27T13:55:37-04:00 Add missing dict binds to specialiser I had forgotten to add the auxiliary dict bindings to the /unfolding/ of a specialised function. This caused #22358, which reports failures when compiling Hackage packages fixed-vector indexed-traversable Regression test T22357 is snarfed from indexed-traversable - - - - - a8ed36f9 by Evan Relf at 2022-10-27T13:56:36-04:00 Fix broken link to `async` package - - - - - 750846cd by Zubin Duggal at 2022-10-28T00:49:22-04:00 Pass correct package db when testing stage1. It used to pick the db for stage-2 which obviously didn't work. - - - - - ad612f55 by Krzysztof Gogolewski at 2022-10-28T00:50:00-04:00 Minor SDoc-related cleanup * Rename pprCLabel to pprCLabelStyle, and use the name pprCLabel for a function using CStyle (analogous to pprAsmLabel) * Move LabelStyle to the CLabel module, it no longer needs to be in Outputable. * Move calls to 'text' right next to literals, to make sure the text/str rule is triggered. * Remove FastString/String roundtrip in Tc.Deriv.Generate * Introduce showSDocForUser', which abstracts over a pattern in GHCi.UI - - - - - c2872f3f by Bryan Richter at 2022-10-28T11:36:34+03:00 CI: Don't run lint-submods on nightly Fixes #22325 - - - - - 270037fa by Hécate Moonlight at 2022-10-28T19:46:12-04:00 Start the deprecation process for GHC.Pack - - - - - d45d8cb3 by M Farkas-Dyck at 2022-11-01T12:47:21-04:00 Drop a kludge for binutils<2.17, which is now over 10 years old. - - - - - 8ee8b418 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: `name` argument of `createOSThread` can be `const` Since we don't intend to ever change the incoming string, declare this to be true. Also, in the POSIX implementation, the argument is no longer `STG_UNUSED` (since ee0deb8054da2a597fc5624469b4c44fd769ada2) in any code path. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 - - - - - 13b5f102 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix lifetime of `start_thread`s `name` value Since, unlike the code in ee0deb8054da2^, usage of the `name` value passed to `createOSThread` now outlives said function's lifetime, and could hence be released by the caller by the time the new thread runs `start_thread`, it needs to be copied. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - edd175c9 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix OS thread naming in ticker Since ee0deb805, the use of `pthread_setname_np` on Darwin was fixed when invoking `createOSThread`. However, the 'ticker' has some thread-creation code which doesn't rely on `createOSThread`, yet also uses `pthread_setname_np`. This patch enforces all thread creation to go through a single function, which uses the (correct) thread-naming code introduced in ee0deb805. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22206 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - b7a00113 by Krzysztof Gogolewski at 2022-11-01T12:48:35-04:00 Typo: rename -fwrite-if-simplfied-core to -fwrite-if-simplified-core - - - - - 30e625e6 by Vladislav Zavialov at 2022-11-01T12:49:10-04:00 ThToHs: fix overzealous parenthesization Before this patch, when converting from TH.Exp to LHsExpr GhcPs, the compiler inserted more parentheses than required: ((f a) (b + c)) d This was happening because the LHS of the function application was parenthesized as if it was the RHS. Now we use funPrec and appPrec appropriately and produce sensibly parenthesized expressions: f a (b + c) d I also took the opportunity to remove the special case for LamE, which was not special at all and simply duplicated code. - - - - - 0560821f by Simon Peyton Jones at 2022-11-01T12:49:47-04:00 Add accurate skolem info when quantifying Ticket #22379 revealed that skolemiseQuantifiedTyVar was dropping the passed-in skol_info on the floor when it encountered a SkolemTv. Bad! Several TyCons thereby share a single SkolemInfo on their binders, which lead to bogus error reports. - - - - - 38d19668 by Fendor at 2022-11-01T12:50:25-04:00 Expose UnitEnvGraphKey for user-code - - - - - 77e24902 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Shrink test case for #22357 Ryan Scott offered a cut-down repro case (60 lines instead of more than 700 lines) - - - - - 4521f649 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Add two tests for #17366 - - - - - 6b400d26 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_NORETURN` Instead of sprinkling the codebase with `GNU(C3)_ATTRIBUTE(__noreturn__)`, add a `STG_NORETURN` macro (for, basically, the same thing) similar to `STG_UNUSED` and others, and update the code to use this macro where applicable. - - - - - f9638654 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: consistently use `STG_UNUSED` - - - - - 81a58433 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_USED` Similar to `STG_UNUSED`, have a specific macro for `__attribute__(used)`. - - - - - 41e1f748 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_MALLOC` Instead of using `GNUC3_ATTRIBUTE(__malloc__)`, provide a `STG_MALLOC` macro definition and use it instead. - - - - - 3a9a8bde by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `STG_UNUSED` - - - - - 9ab999de by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: specify deallocator of allocating functions This patch adds a new `STG_MALLOC1` macro (and its counterpart `STG_MALLOC2` for completeness) which allows to specify the deallocation function to be used with allocations of allocating functions, and applies it to `stg*allocBytes`. It also fixes a case where `free` was used to free up an `stgMallocBytes` allocation, found by the above change. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-malloc-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 81c0c7c9 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `alloc_size` attribute This patch adds the `STG_ALLOC_SIZE1` and `STG_ALLOC_SIZE2` macros which allow to set the `alloc_size` attribute on functions, when available. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-alloc_005fsize-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 99a1d896 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: add and use `STG_RETURNS_NONNULL` See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-returns_005fnonnull-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - c235b399 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: tag `stgStrndup` as `STG_MALLOC` See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - ed81b448 by Oleg Grenrus at 2022-11-02T12:07:27-04:00 Move Symbol implementation note out of public haddock - - - - - 284fd39c by Ben Gamari at 2022-11-03T01:58:54-04:00 gen-dll: Drop it Currently it is only used by the make build system, which is soon to be retired, and it has not built since 41cf758b. We may need to reintroduce it when dynamic-linking support is introduced on Windows, but we will cross that bridge once we get there. Fixes #21753. - - - - - 24f4f54f by Matthew Pickering at 2022-11-03T01:59:30-04:00 Port foundation numeric tests to GHC testsuite This commit ports the numeric tests which found a regression in GHC-9.4. https://github.com/haskell-foundation/foundation/issues/571 Included in the commit is a simple random number generator and simplified QuickCheck implementation. In future these could be factored out of this standalone file and reused as a general purpose library which could be used for other QuickCheck style tests in the testsuite. See #22282 - - - - - d51bf7bd by M Farkas-Dyck at 2022-11-03T02:00:13-04:00 git: ignore HIE files. Cleans up git status if one sets -fwrite-ide-info in hadrian/ghci. - - - - - a9fc15b1 by Matthew Pickering at 2022-11-03T02:00:49-04:00 Clarify status of bindings in WholeCoreBindings Gergo points out that these bindings are tidied, rather than prepd as the variable claims. Therefore we update the name of the variable to reflect reality and add a comment to the data type to try to erase any future confusion. Fixes #22307 - - - - - 634da448 by Bodigrim at 2022-11-03T21:25:02+00:00 Fix haddocks for GHC.IORef - - - - - 31125154 by Andreas Klebinger at 2022-11-03T23:08:09-04:00 Export pprTrace and friends from GHC.Prelude. Introduces GHC.Prelude.Basic which can be used in modules which are a dependency of the ppr code. - - - - - bdc8cbb3 by Bryan Richter at 2022-11-04T10:27:37+02:00 CI: Allow hadrian-ghc-in-ghci to run in nightlies Since lint-submods doesn't run in nightlies, hadrian-ghc-in-ghci needs to mark it as "optional" so it can run if the job doesn't exist. Fixes #22396. - - - - - 3c0e3793 by Krzysztof Gogolewski at 2022-11-05T00:29:57-04:00 Minor refactor around FastStrings Pass FastStrings to functions directly, to make sure the rule for fsLit "literal" fires. Remove SDoc indirection in GHCi.UI.Tags and GHC.Unit.Module.Graph. - - - - - e41b2f55 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump unix submodule to 2.8.0.0 Also bumps process and ghc-boot bounds on unix. For hadrian, when cross-compiling, we add -Wwarn=unused-imports -Wwarn=unused-top-binds to validation flavour. Further fixes in unix and/or hsc2hs is needed to make it completely free of warnings; for the time being, this change is needed to unblock other cross-compilation related work. - - - - - 42938a58 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump Win32 submodule to 2.13.4.0 Fixes #22098 - - - - - e7372bc5 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump ci-images revision ci-images has recently been updated, including changes needed for wasm32-wasi CI. - - - - - 88cb9492 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump gmp-tarballs submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 69427ce9 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump haskeline submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 5fe11fe6 by Carter Schonwald at 2022-11-07T13:22:14-05:00 bump llvm upper bound - - - - - 68f49874 by M Farkas-Dyck at 2022-11-08T12:53:55-05:00 Define `Infinite` list and use where appropriate. Also add perf test for infinite list fusion. In particular, in `GHC.Core`, often we deal with infinite lists of roles. Also in a few locations we deal with infinite lists of names. Thanks to simonpj for helping to write the Note [Fusion for `Infinite` lists]. - - - - - ce726cd2 by Ross Paterson at 2022-11-08T12:54:34-05:00 Fix TypeData issues (fixes #22315 and #22332) There were two bugs here: 1. Treating type-level constructors as PromotedDataCon doesn't always work, in particular because constructors promoted via DataKinds are called both T and 'T. (Tests T22332a, T22332b, T22315a, T22315b) Fix: guard these cases with isDataKindsPromotedDataCon. 2. Type-level constructors were sent to the code generator, producing things like constructor wrappers. (Tests T22332a, T22332b) Fix: test for them in isDataTyCon. Other changes: * changed the marking of "type data" DataCon's as suggested by SPJ. * added a test TDGADT for a type-level GADT. * comment tweaks * change tcIfaceTyCon to ignore IfaceTyConInfo, so that IfaceTyConInfo is used only for pretty printing, not for typechecking. (SPJ) - - - - - 132f8908 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Clarify msum/asum documentation - - - - - bb5888c5 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Add example for (<$) - - - - - 080fffa1 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Document what Alternative/MonadPlus instances actually do - - - - - 92ccb8de by Giles Anderson at 2022-11-09T09:27:52-05:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Instance (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnWarnUnsatisfiedMinimalDefinition TcRnMisplacedInstSig TcRnBadBootFamInstDeclErr TcRnIllegalFamilyInstance TcRnAssocInClassErr TcRnBadFamInstDecl TcRnNotOpenFamily - - - - - 90c5abd4 by Hécate Moonlight at 2022-11-09T09:28:30-05:00 GHCi tags generation phase 2 see #19884 - - - - - f9f17b68 by Simon Peyton Jones at 2022-11-10T12:20:03+00:00 Fire RULES in the Specialiser The Specialiser has, for some time, fires class-op RULES in the specialiser itself: see Note [Specialisation modulo dictionary selectors] This MR beefs it up a bit, so that it fires /all/ RULES in the specialiser, not just class-op rules. See Note [Fire rules in the specialiser] The result is a bit more specialisation; see test simplCore/should_compile/T21851_2 This pushed me into a bit of refactoring. I made a new data types GHC.Core.Rules.RuleEnv, which combines - the several source of rules (local, home-package, external) - the orphan-module dependencies in a single record for `getRules` to consult. That drove a bunch of follow-on refactoring, including allowing me to remove cr_visible_orphan_mods from the CoreReader data type. I moved some of the RuleBase/RuleEnv stuff into GHC.Core.Rule. The reorganisation in the Simplifier improve compile times a bit (geom mean -0.1%), but T9961 is an outlier Metric Decrease: T9961 - - - - - 2b3d0bee by Simon Peyton Jones at 2022-11-10T12:21:13+00:00 Make indexError work better The problem here is described at some length in Note [Boxity for bottoming functions] and Note [Reboxed crud for bottoming calls] in GHC.Core.Opt.DmdAnal. This patch adds a SPECIALISE pragma for indexError, which makes it much less vulnerable to the problem described in these Notes. (This came up in another line of work, where a small change made indexError do reboxing (in nofib/spectral/simple/table_sort) that didn't happen before my change. I've opened #22404 to document the fagility. - - - - - 399e921b by Simon Peyton Jones at 2022-11-10T12:21:14+00:00 Fix DsUselessSpecialiseForClassMethodSelector msg The error message for DsUselessSpecialiseForClassMethodSelector was just wrong (a typo in some earlier work); trivial fix - - - - - dac0682a by Sebastian Graf at 2022-11-10T21:16:01-05:00 WorkWrap: Unboxing unboxed tuples is not always useful (#22388) See Note [Unboxing through unboxed tuples]. Fixes #22388. - - - - - 1230c268 by Sebastian Graf at 2022-11-10T21:16:01-05:00 Boxity: Handle argument budget of unboxed tuples correctly (#21737) Now Budget roughly tracks the combined width of all arguments after unarisation. See the changes to `Note [Worker argument budgets]`. Fixes #21737. - - - - - 2829fd92 by Cheng Shao at 2022-11-11T00:26:54-05:00 autoconf: check getpid getuid raise This patch adds checks for getpid, getuid and raise in autoconf. These functions are absent in wasm32-wasi and thus needs to be checked. - - - - - f5dfd1b4 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add -Wwarn only for cross-compiling unix - - - - - 2e6ab453 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add targetSupportsThreadedRts flag This patch adds a targetSupportsThreadedRts flag to indicate whether the target supports the threaded rts at all, different from existing targetSupportsSMP that checks whether -N is supported by the RTS. All existing flavours have also been updated accordingly to respect this flags. Some targets (e.g. wasm32-wasi) does not support the threaded rts, therefore this flag is needed for the default flavours to work. It makes more sense to have proper autoconf logic to check for threading support, but for the time being, we just set the flag to False iff the target is wasm32. - - - - - 8104f6f5 by Cheng Shao at 2022-11-11T00:26:55-05:00 Fix Cmm symbol kind - - - - - b2035823 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add the two key graph modules from Martin Erwig's FGL Martin Erwig's FGL (Functional Graph Library) provides an "inductive" representation of graphs. A general graph has labeled nodes and labeled edges. The key operation on a graph is to decompose it by removing one node, together with the edges that connect the node to the rest of the graph. There is also an inverse composition operation. The decomposition and composition operations make this representation of graphs exceptionally well suited to implement graph algorithms in which the graph is continually changing, as alluded to in #21259. This commit adds `GHC.Data.Graph.Inductive.Graph`, which defines the interface, and `GHC.Data.Graph.Inductive.PatriciaTree`, which provides an implementation. Both modules are taken from `fgl-5.7.0.3` on Hackage, with these changes: - Copyright and license text have been copied into the files themselves, not stored separately. - Some calls to `error` have been replaced with calls to `panic`. - Conditional-compilation support for older versions of GHC, `containers`, and `base` has been removed. - - - - - 3633a5f5 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add new modules for reducibility and WebAssembly translation - - - - - df7bfef8 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add support for the wasm32-wasi target tuple This patch adds the wasm32-wasi tuple support to various places in the tree: autoconf, hadrian, ghc-boot and also the compiler. The codegen logic will come in subsequent commits. - - - - - 32ae62e6 by Cheng Shao at 2022-11-11T00:26:55-05:00 deriveConstants: parse .ll output for wasm32 due to broken nm This patch makes deriveConstants emit and parse an .ll file when targeting wasm. It's a necessary workaround for broken llvm-nm on wasm, which isn't capable of reporting correct constant values when parsing an object. - - - - - 07e92c92 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: workaround cmm's improper variadic ccall breaking wasm32 typechecking Unlike other targets, wasm requires the function signature of the call site and callee to strictly match. So in Cmm, when we call a C function that actually returns a value, we need to add an _unused local variable to receive it, otherwise type error awaits. An even bigger problem is calling variadic functions like barf() and such. Cmm doesn't support CAPI calling convention yet, so calls to variadic functions just happen to work in some cases with some target's ABI. But again, it doesn't work with wasm. Fortunately, the wasm C ABI lowers varargs to a stack pointer argument, and it can be passed NULL when no other arguments are expected to be passed. So we also add the additional unused NULL arguments to those functions, so to fix wasm, while not affecting behavior on other targets. - - - - - 00124d12 by Cheng Shao at 2022-11-11T00:26:55-05:00 testsuite: correct sleep() signature in T5611 In libc, sleep() returns an integer. The ccall type signature should match the libc definition, otherwise it causes linker error on wasm. - - - - - d72466a9 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: prefer ffi_type_void over FFI_TYPE_VOID This patch uses ffi_type_void instead of FFI_TYPE_VOID in the interpreter code, since the FFI_TYPE_* macros are not available in libffi-wasm32 yet. The libffi public documentation also only mentions the lower-case ffi_type_* symbols, so we should prefer the lower-case API here. - - - - - 4d36a1d3 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't define RTS_USER_SIGNALS when signal.h is not present In the rts, we have a RTS_USER_SIGNALS macro, and most signal-related logic is guarded with RTS_USER_SIGNALS. This patch extends the range of code guarded with RTS_USER_SIGNALS, and define RTS_USER_SIGNALS iff signal.h is actually detected by autoconf. This is required for wasm32-wasi to work, which lacks signals. - - - - - 3f1e164f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: use HAVE_GETPID to guard subprocess related logic We've previously added detection of getpid() in autoconf. This patch uses HAVE_GETPID to guard some subprocess related logic in the RTS. This is required for certain targets like wasm32-wasi, where there isn't a process model at all. - - - - - 50bf5e77 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: IPE.c: don't do mutex stuff when THREADED_RTS is not defined This patch adds the missing THREADED_RTS CPP guard to mutex logic in IPE.c. - - - - - ed3b3da0 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: genericRaise: use exit() instead when not HAVE_RAISE We check existence of raise() in autoconf, and here, if not HAVE_RAISE, we should use exit() instead in genericRaise. - - - - - c0ba1547 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: checkSuid: don't do it when not HAVE_GETUID When getuid() is not present, don't do checkSuid since it doesn't make sense anyway on that target. - - - - - d2d6dfd2 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 placeholder linker This patch adds minimal placeholder linker logic for wasm32, just enough to unblock compiling rts on wasm32. RTS linker functionality is not properly implemented yet for wasm32. - - - - - 65ba3285 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: chdir to PWD on wasm32 This patch adds a wasm32-specific behavior to RtsStartup logic. When the PWD environment variable is present, we chdir() to it first. The point is to workaround an issue in wasi-libc: it's currently not possible to specify the initial working directory, it always defaults to / (in the virtual filesystem mapped from some host directory). For some use cases this is sufficient, but there are some other cases (e.g. in the testsuite) where the program needs to access files outside. - - - - - 65b82542 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: no timer for wasm32 Due to the lack of threads, on wasm32 there can't be a background timer that periodically resets the context switch flag. This patch disables timer for wasm32, and also makes the scheduler default to -C0 on wasm32 to avoid starving threads. - - - - - e007586f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsSymbols: empty RTS_POSIX_ONLY_SYMBOLS for wasm32 The default RTS_POSIX_ONLY_SYMBOLS doesn't make sense on wasm32. - - - - - 0e33f667 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: Schedule: no FORKPROCESS_PRIMOP_SUPPORTED on wasm32 On wasm32 there isn't a process model at all, so no FORKPROCESS_PRIMOP_SUPPORTED. - - - - - 88bbdb31 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: LibffiAdjustor: adapt to ffi_alloc_prep_closure interface for wasm32 libffi-wasm32 only supports non-standard libffi closure api via ffi_alloc_prep_closure(). This patch implements ffi_alloc_prep_closure() via standard libffi closure api on other targets, and uses it to implement adjustor functionality. - - - - - 15138746 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't return memory to OS on wasm32 This patch makes the storage manager not return any memory on wasm32. The detailed reason is described in Note [Megablock allocator on wasm]. - - - - - 631af3cc by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: make flushExec a no-op on wasm32 This patch makes flushExec a no-op on wasm32, since there's no such thing as executable memory on wasm32 in the first place. - - - - - 654a3d46 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: don't call resetTerminalSettings, freeThreadingResources on wasm32 This patch prevents resetTerminalSettings and freeThreadingResources to be called on wasm32, since there is no TTY or threading on wasm32 at all. - - - - - f271e7ca by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: OSThreads.h: stub types for wasm32 This patch defines stub Condition/Mutex/OSThreadId/ThreadLocalKey types for wasm32, just enough to unblock compiling RTS. Any threading-related functionality has been patched to be disabled on wasm32. - - - - - a6ac67b0 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add register mapping for wasm32 This patch adds register mapping logic for wasm32. See Note [Register mapping on WebAssembly] in wasm32 NCG for more description. - - - - - d7b33982 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 specific logic This patch adds the rest of wasm32 specific logic in rts. - - - - - 7f59b0f3 by Cheng Shao at 2022-11-11T00:26:55-05:00 base: fall back to using monotonic clock to emulate cputime on wasm32 On wasm32, we have to fall back to using monotonic clock to emulate cputime, since there's no native support for cputime as a clock id. - - - - - 5fcbae0b by Cheng Shao at 2022-11-11T00:26:55-05:00 base: more autoconf checks for wasm32 This patch adds more autoconf checks to base, since those functions and headers may exist on other POSIX systems but don't exist on wasm32. - - - - - 00a9359f by Cheng Shao at 2022-11-11T00:26:55-05:00 base: avoid using unsupported posix functionality on wasm32 This base patch avoids using unsupported posix functionality on wasm32. - - - - - 34b8f611 by Cheng Shao at 2022-11-11T00:26:55-05:00 autoconf: set CrossCompiling=YES in cross bindist configure This patch fixes the bindist autoconf logic to properly set CrossCompiling=YES when it's a cross GHC bindist. - - - - - 5ebeaa45 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: add util functions for UniqFM and UniqMap This patch adds addToUFM_L (backed by insertLookupWithKey), addToUniqMap_L and intersectUniqMap_C. These UniqFM/UniqMap util functions are used by the wasm32 NCG. - - - - - 177c56c1 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: avoid -Wl,--no-as-needed for wasm32 The driver used to pass -Wl,--no-as-needed for LLD linking. This is actually only supported for ELF targets, and must be avoided when linking for wasm32. - - - - - 06f01c74 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: allow big arith for wasm32 This patch enables Cmm big arithmetic on wasm32, since 64-bit arithmetic can be efficiently lowered to wasm32 opcodes. - - - - - df6bb112 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: pass -Wa,--no-type-check for wasm32 when runAsPhase This patch passes -Wa,--no-type-check for wasm32 when compiling assembly. See the added note for more detailed explanation. - - - - - c1fe4ab6 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: enforce cmm switch planning for wasm32 This patch forcibly enable Cmm switch planning for wasm32, since otherwise the switch tables we generate may exceed the br_table maximum allowed size. - - - - - a8adc71e by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: annotate CmmFileEmbed with blob length This patch adds the blob length field to CmmFileEmbed. The wasm32 NCG needs to know the precise size of each data segment. - - - - - 36340328 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: wasm32 NCG This patch adds the wasm32 NCG. - - - - - 435f42ea by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add wasm32-wasi release bindist job - - - - - d8262fdc by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add a stronger test for cross bindists This commit adds a simple GHC API program that parses and reprints the original hello world program used for basic testing of cross bindists. Before there's full cross-compilation support in the test suite driver, this provides better coverage than the original test. - - - - - 8e6ae882 by Cheng Shao at 2022-11-11T00:26:55-05:00 CODEOWNERS: add wasm-specific maintainers - - - - - 707d5651 by Zubin Duggal at 2022-11-11T00:27:31-05:00 Clarify that LLVM upper bound is non-inclusive during configure (#22411) - - - - - 430eccef by Ben Gamari at 2022-11-11T13:16:45-05:00 rts: Check for program_invocation_short_name via autoconf Instead of assuming support on all Linuxes. - - - - - 6dab0046 by Matthew Pickering at 2022-11-11T13:17:22-05:00 driver: Fix -fdefer-diagnostics flag The `withDeferredDiagnostics` wrapper wasn't doing anything because the session it was modifying wasn't used in hsc_env. Therefore the fix is simple, just push the `getSession` call into the scope of `withDeferredDiagnostics`. Fixes #22391 - - - - - d0c691b6 by Simon Peyton Jones at 2022-11-11T13:18:07-05:00 Add a fast path for data constructor workers See Note [Fast path for data constructors] in GHC.Core.Opt.Simplify.Iteration This bypasses lots of expensive logic, in the special case of applications of data constructors. It is a surprisingly worthwhile improvement, as you can see in the figures below. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Read(normal) -2.0% CoOpt_Singletons(normal) -2.0% ManyConstructors(normal) -1.3% T10421(normal) -1.9% GOOD T10421a(normal) -1.5% T10858(normal) -1.6% T11545(normal) -1.7% T12234(optasm) -1.3% T12425(optasm) -1.9% GOOD T13035(normal) -1.0% GOOD T13056(optasm) -1.8% T13253(normal) -3.3% GOOD T15164(normal) -1.7% T15304(normal) -3.4% T15630(normal) -2.8% T16577(normal) -4.3% GOOD T17096(normal) -1.1% T17516(normal) -3.1% T18282(normal) -1.9% T18304(normal) -1.2% T18698a(normal) -1.2% GOOD T18698b(normal) -1.5% GOOD T18923(normal) -1.3% T1969(normal) -1.3% GOOD T19695(normal) -4.4% GOOD T21839c(normal) -2.7% GOOD T21839r(normal) -2.7% GOOD T4801(normal) -3.8% GOOD T5642(normal) -3.1% GOOD T6048(optasm) -2.5% GOOD T9020(optasm) -2.7% GOOD T9630(normal) -2.1% GOOD T9961(normal) -11.7% GOOD WWRec(normal) -1.0% geo. mean -1.1% minimum -11.7% maximum +0.1% Metric Decrease: T10421 T12425 T13035 T13253 T16577 T18698a T18698b T1969 T19695 T21839c T21839r T4801 T5642 T6048 T9020 T9630 T9961 - - - - - 3c37d30b by Krzysztof Gogolewski at 2022-11-11T19:18:39+01:00 Use a more efficient printer for code generation (#21853) The changes in `GHC.Utils.Outputable` are the bulk of the patch and drive the rest. The types `HLine` and `HDoc` in Outputable can be used instead of `SDoc` and support printing directly to a handle with `bPutHDoc`. See Note [SDoc versus HDoc] and Note [HLine versus HDoc]. The classes `IsLine` and `IsDoc` are used to make the existing code polymorphic over `HLine`/`HDoc` and `SDoc`. This is done for X86, PPC, AArch64, DWARF and dependencies (printing module names, labels etc.). Co-authored-by: Alexis King <lexi.lambda at gmail.com> Metric Decrease: CoOpt_Read ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13379 T18140 T18282 T18698a T18698b T1969 T20049 T21839c T21839r T3064 T3294 T4801 T5321FD T5321Fun T5631 T6048 T783 T9198 T9233 - - - - - 6b92b47f by Matthew Craven at 2022-11-11T18:32:14-05:00 Weaken wrinkle 1 of Note [Scrutinee Constant Folding] Fixes #22375. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 154c70f6 by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Fix fragile RULE setup in GHC.Float In testing my type-vs-constraint patch I found that the handling of Natural literals was very fragile -- and I somehow tripped that fragility in my work. So this patch fixes the fragility. See Note [realToFrac natural-to-float] This made a big (9%) difference in one existing test in perf/should_run/T1-359 Metric Decrease: T10359 - - - - - 778c6adc by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Type vs Constraint: finally nailed This big patch addresses the rats-nest of issues that have plagued us for years, about the relationship between Type and Constraint. See #11715/#21623. The main payload of the patch is: * To introduce CONSTRAINT :: RuntimeRep -> Type * To make TYPE and CONSTRAINT distinct throughout the compiler Two overview Notes in GHC.Builtin.Types.Prim * Note [TYPE and CONSTRAINT] * Note [Type and Constraint are not apart] This is the main complication. The specifics * New primitive types (GHC.Builtin.Types.Prim) - CONSTRAINT - ctArrowTyCon (=>) - tcArrowTyCon (-=>) - ccArrowTyCon (==>) - funTyCon FUN -- Not new See Note [Function type constructors and FunTy] and Note [TYPE and CONSTRAINT] * GHC.Builtin.Types: - New type Constraint = CONSTRAINT LiftedRep - I also stopped nonEmptyTyCon being built-in; it only needs to be wired-in * Exploit the fact that Type and Constraint are distinct throughout GHC - Get rid of tcView in favour of coreView. - Many tcXX functions become XX functions. e.g. tcGetCastedTyVar --> getCastedTyVar * Kill off Note [ForAllTy and typechecker equality], in (old) GHC.Tc.Solver.Canonical. It said that typechecker-equality should ignore the specified/inferred distinction when comparein two ForAllTys. But that wsa only weakly supported and (worse) implies that we need a separate typechecker equality, different from core equality. No no no. * GHC.Core.TyCon: kill off FunTyCon in data TyCon. There was no need for it, and anyway now we have four of them! * GHC.Core.TyCo.Rep: add two FunTyFlags to FunCo See Note [FunCo] in that module. * GHC.Core.Type. Lots and lots of changes driven by adding CONSTRAINT. The key new function is sORTKind_maybe; most other changes are built on top of that. See also `funTyConAppTy_maybe` and `tyConAppFun_maybe`. * Fix a longstanding bug in GHC.Core.Type.typeKind, and Core Lint, in kinding ForAllTys. See new tules (FORALL1) and (FORALL2) in GHC.Core.Type. (The bug was that before (forall (cv::t1 ~# t2). blah), where blah::TYPE IntRep, would get kind (TYPE IntRep), but it should be (TYPE LiftedRep). See Note [Kinding rules for types] in GHC.Core.Type. * GHC.Core.TyCo.Compare is a new module in which we do eqType and cmpType. Of course, no tcEqType any more. * GHC.Core.TyCo.FVs. I moved some free-var-like function into this module: tyConsOfType, visVarsOfType, and occCheckExpand. Refactoring only. * GHC.Builtin.Types. Compiletely re-engineer boxingDataCon_maybe to have one for each /RuntimeRep/, rather than one for each /Type/. This dramatically widens the range of types we can auto-box. See Note [Boxing constructors] in GHC.Builtin.Types The boxing types themselves are declared in library ghc-prim:GHC.Types. GHC.Core.Make. Re-engineer the treatment of "big" tuples (mkBigCoreVarTup etc) GHC.Core.Make, so that it auto-boxes unboxed values and (crucially) types of kind Constraint. That allows the desugaring for arrows to work; it gathers up free variables (including dictionaries) into tuples. See Note [Big tuples] in GHC.Core.Make. There is still work to do here: #22336. But things are better than before. * GHC.Core.Make. We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and aBSENT_CONSTRAINT_ERROR_ID for vaues of kind Constraint. Ditto noInlineId vs noInlieConstraintId in GHC.Types.Id.Make; see Note [inlineId magic]. * GHC.Core.TyCo.Rep. Completely refactor the NthCo coercion. It is now called SelCo, and its fields are much more descriptive than the single Int we used to have. A great improvement. See Note [SelCo] in GHC.Core.TyCo.Rep. * GHC.Core.RoughMap.roughMatchTyConName. Collapse TYPE and CONSTRAINT to a single TyCon, so that the rough-map does not distinguish them. * GHC.Core.DataCon - Mainly just improve documentation * Some significant renamings: GHC.Core.Multiplicity: Many --> ManyTy (easier to grep for) One --> OneTy GHC.Core.TyCo.Rep TyCoBinder --> GHC.Core.Var.PiTyBinder GHC.Core.Var TyCoVarBinder --> ForAllTyBinder AnonArgFlag --> FunTyFlag ArgFlag --> ForAllTyFlag GHC.Core.TyCon TyConTyCoBinder --> TyConPiTyBinder Many functions are renamed in consequence e.g. isinvisibleArgFlag becomes isInvisibleForAllTyFlag, etc * I refactored FunTyFlag (was AnonArgFlag) into a simple, flat data type data FunTyFlag = FTF_T_T -- (->) Type -> Type | FTF_T_C -- (-=>) Type -> Constraint | FTF_C_T -- (=>) Constraint -> Type | FTF_C_C -- (==>) Constraint -> Constraint * GHC.Tc.Errors.Ppr. Some significant refactoring in the TypeEqMisMatch case of pprMismatchMsg. * I made the tyConUnique field of TyCon strict, because I saw code with lots of silly eval's. That revealed that GHC.Settings.Constants.mAX_SUM_SIZE can only be 63, because we pack the sum tag into a 6-bit field. (Lurking bug squashed.) Fixes * #21530 Updates haddock submodule slightly. Performance changes ~~~~~~~~~~~~~~~~~~~ I was worried that compile times would get worse, but after some careful profiling we are down to a geometric mean 0.1% increase in allocation (in perf/compiler). That seems fine. There is a big runtime improvement in T10359 Metric Decrease: LargeRecord MultiLayerModulesTH_OneShot T13386 T13719 Metric Increase: T8095 - - - - - 360f5fec by Simon Peyton Jones at 2022-11-11T23:40:11+00:00 Indent closing "#-}" to silence HLint - - - - - e160cf47 by Krzysztof Gogolewski at 2022-11-12T08:05:28-05:00 Fix merge conflict in T18355.stderr Fixes #22446 - - - - - 294f9073 by Simon Peyton Jones at 2022-11-12T23:14:13+00:00 Fix a trivial typo in dataConNonlinearType Fixes #22416 - - - - - 268a3ce9 by Ben Gamari at 2022-11-14T09:36:57-05:00 eventlog: Ensure that IPE output contains actual info table pointers The refactoring in 866c736e introduced a rather subtle change in the semantics of the IPE eventlog output, changing the eventlog field from encoding info table pointers to "TNTC pointers" (which point to entry code when tables-next-to-code is enabled). Fix this. Fixes #22452. - - - - - d91db679 by Matthew Pickering at 2022-11-14T16:48:10-05:00 testsuite: Add tests for T22347 These are fixed in recent versions but might as well add regression tests. See #22347 - - - - - 8f6c576b by Matthew Pickering at 2022-11-14T16:48:45-05:00 testsuite: Improve output from tests which have failing pre_cmd There are two changes: * If a pre_cmd fails, then don't attempt to run the test. * If a pre_cmd fails, then print the stdout and stderr from running that command (which hopefully has a nice error message). For example: ``` =====> 1 of 1 [0, 0, 0] *** framework failure for test-defaulting-plugin(normal) pre_cmd failed: 2 ** pre_cmd was "$MAKE -s --no-print-directory -C defaulting-plugin package.test-defaulting-plugin TOP={top}". stdout: stderr: DefaultLifted.hs:19:13: error: [GHC-76037] Not in scope: type constructor or class ‘Typ’ Suggested fix: Perhaps use one of these: ‘Type’ (imported from GHC.Tc.Utils.TcType), data constructor ‘Type’ (imported from GHC.Plugins) | 19 | instance Eq Typ where | ^^^ make: *** [Makefile:17: package.test-defaulting-plugin] Error 1 Performance Metrics (test environment: local): ``` Fixes #22329 - - - - - 2b7d5ccc by Madeline Haraj at 2022-11-14T22:44:17+00:00 Implement UNPACK support for sum types. This is based on osa's unpack_sums PR from ages past. The meat of the patch is implemented in dataConArgUnpackSum and described in Note [UNPACK for sum types]. - - - - - 78f7ecb0 by Andreas Klebinger at 2022-11-14T22:20:29-05:00 Expand on the need to clone local binders. Fixes #22402. - - - - - 65ce43cc by Krzysztof Gogolewski at 2022-11-14T22:21:05-05:00 Fix :i Constraint printing "type Constraint = Constraint" Since Constraint became a synonym for CONSTRAINT 'LiftedRep, we need the same code for handling printing as for the synonym Type = TYPE 'LiftedRep. This addresses the same bug as #18594, so I'm reusing the test. - - - - - 94549f8f by ARATA Mizuki at 2022-11-15T21:36:03-05:00 configure: Don't check for an unsupported version of LLVM The upper bound is not inclusive. Fixes #22449 - - - - - 02d3511b by Bodigrim at 2022-11-15T21:36:41-05:00 Fix capitalization in haddock for TestEquality - - - - - 08bf2881 by Cheng Shao at 2022-11-16T09:16:29+00:00 base: make Foreign.Marshal.Pool use RTS internal arena for allocation `Foreign.Marshal.Pool` used to call `malloc` once for each allocation request. Each `Pool` maintained a list of allocated pointers, and traverses the list to `free` each one of those pointers. The extra O(n) overhead is apparently bad for a `Pool` that serves a lot of small allocation requests. This patch uses the RTS internal arena to implement `Pool`, with these benefits: - Gets rid of the extra O(n) overhead. - The RTS arena is simply a bump allocator backed by the block allocator, each allocation request is likely faster than a libc `malloc` call. Closes #14762 #18338. - - - - - 37cfe3c0 by Krzysztof Gogolewski at 2022-11-16T14:50:06-05:00 Misc cleanup * Replace catMaybes . map f with mapMaybe f * Use concatFS to concatenate multiple FastStrings * Fix documentation of -exclude-module * Cleanup getIgnoreCount in GHCi.UI - - - - - b0ac3813 by Lawton Nichols at 2022-11-19T03:22:14-05:00 Give better errors for code corrupted by Unicode smart quotes (#21843) Previously, we emitted a generic and potentially confusing error during lexical analysis on programs containing smart quotes (“/”/‘/’). This commit adds smart quote-aware lexer errors. - - - - - cb8430f8 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make OpaqueNo* tests less noisy to unrelated changes - - - - - b1a8af69 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Simplifier: Consider `seq` as a `BoringCtxt` (#22317) See `Note [Seq is boring]` for the rationale. Fixes #22317. - - - - - 9fd11585 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make T21839c's ghc/max threshold more forgiving - - - - - 4b6251ab by Simon Peyton Jones at 2022-11-19T03:23:24-05:00 Be more careful when reporting unbound RULE binders See Note [Variables unbound on the LHS] in GHC.HsToCore.Binds. Fixes #22471. - - - - - e8f2b80d by Peter Trommler at 2022-11-19T03:23:59-05:00 PPC NCG: Fix generating assembler code Fixes #22479 - - - - - f2f9ef07 by Bodigrim at 2022-11-20T18:39:30-05:00 Extend documentation for Data.IORef - - - - - ef511b23 by Simon Peyton Jones at 2022-11-20T18:40:05-05:00 Buglet in GHC.Tc.Module.checkBootTyCon This lurking bug used the wrong function to compare two types in GHC.Tc.Module.checkBootTyCon It's hard to trigger the bug, which only came up during !9343, so there's no regression test in this MR. - - - - - 451aeac3 by Bodigrim at 2022-11-20T18:40:44-05:00 Add since pragmas for c_interruptible_open and hostIsThreaded - - - - - 8d6aaa49 by Duncan Coutts at 2022-11-22T02:06:16-05:00 Introduce CapIOManager as the per-cap I/O mangager state Rather than each I/O manager adding things into the Capability structure ad-hoc, we should have a common CapIOManager iomgr member of the Capability structure, with a common interface to initialise etc. The content of the CapIOManager struct will be defined differently for each I/O manager implementation. Eventually we should be able to have the CapIOManager be opaque to the rest of the RTS, and known just to the I/O manager implementation. We plan for that by making the Capability contain a pointer to the CapIOManager rather than containing the structure directly. Initially just move the Unix threaded I/O manager's control FD. - - - - - 8901285e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Add hook markCapabilityIOManager To allow I/O managers to have GC roots in the Capability, within the CapIOManager structure. Not yet used in this patch. - - - - - 5cf709c5 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move APPEND_TO_BLOCKED_QUEUE from cmm to C The I/O and delay blocking primitives for the non-threaded way currently access the blocked_queue and sleeping_queue directly. We want to move where those queues are to make their ownership clearer: to have them clearly belong to the I/O manager impls rather than to the scheduler. Ultimately we will want to change their representation too. It's inconvenient to do that if these queues are accessed directly from cmm code. So as a first step, replace the APPEND_TO_BLOCKED_QUEUE with a C version appendToIOBlockedQueue(), and replace the open-coded sleeping_queue insertion with insertIntoSleepingQueue(). - - - - - ced9acdb by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move {blocked,sleeping}_queue from scheduler global vars to CapIOManager The blocked_queue_{hd,tl} and the sleeping_queue are currently cooperatively managed between the scheduler and (some but not all of) the non-threaded I/O manager implementations. They lived as global vars with the scheduler, but are poked by I/O primops and the I/O manager backends. This patch is a step on the path towards making the management of I/O or timer blocking belong to the I/O managers and not the scheduler. Specifically, this patch moves the {blocked,sleeping}_queue from being global vars in the scheduler to being members of the CapIOManager struct within each Capability. They are not yet exclusively used by the I/O managers: they are still poked from a couple other places, notably in the scheduler before calling awaitEvent. - - - - - 0f68919e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Remove the now-unused markScheduler The global vars {blocked,sleeping}_queue are now in the Capability and so get marked there via markCapabilityIOManager. - - - - - 39a91f60 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move macros for checking for pending IO or timers from Schedule.h to Schedule.c and IOManager.h This is just moving, the next step will be to rejig them slightly. For the non-threaded RTS the scheduler needs to be able to test for there being pending I/O operation or pending timers. The implementation of these tests should really be considered to be part of the I/O managers and not part of the scheduler. - - - - - 664b034b by Duncan Coutts at 2022-11-22T02:06:17-05:00 Replace EMPTY_{BLOCKED,SLEEPING}_QUEUE macros by function These are the macros originaly from Scheduler.h, previously moved to IOManager.h, and now replaced with a single inline function anyPendingTimeoutsOrIO(). We can use a single function since the two macros were always checked together. Note that since anyPendingTimeoutsOrIO is defined for all IO manager cases, including threaded, we do not need to guard its use by cpp #if !defined(THREADED_RTS) - - - - - 32946220 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Expand emptyThreadQueues inline for clarity It was not really adding anything. The name no longer meant anything since those I/O and timeout queues do not belong to the scheuler. In one of the two places it was used, the comments already had to explain what it did, whereas now the code matches the comment nicely. - - - - - 9943baf9 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move the awaitEvent declaration into IOManager.h And add or adjust comments at the use sites of awaitEvent. - - - - - 054dcc9d by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to awaitEvent It is currently only used in the non-threaded RTS so it works to use MainCapability, but it's a bit nicer to pass the cap anyway. It's certainly shorter. - - - - - 667fe5a4 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to appendToIOBlockedQueue And to insertIntoSleepingQueue. Again, it's a bit cleaner and simpler though not strictly necessary given that these primops are currently only used in the non-threaded RTS. - - - - - 7181b074 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Reveiew feedback: improve one of the TODO comments The one about the nonsense (const False) test on WinIO for there being any IO or timers pending, leading to unnecessary complication later in the scheduler. - - - - - e5b68183 by Andreas Klebinger at 2022-11-22T02:06:52-05:00 Optimize getLevity. Avoid the intermediate data structures allocated by splitTyConApp. This avoids ~0.5% of allocations for a build using -O2. Fixes #22254 - - - - - de5fb348 by Andreas Klebinger at 2022-11-22T02:07:28-05:00 hadrian:Set TNTC when running testsuite. - - - - - 9d61c182 by Oleg Grenrus at 2022-11-22T15:59:34-05:00 Add unsafePtrEquality# restricted to UnliftedTypes - - - - - e817c871 by Jonathan Dowland at 2022-11-22T16:00:14-05:00 utils/unlit: adjust parser to match Report spec The Haskell 2010 Report says that, for Latex-style Literate format, "Program code begins on the first line following a line that begins \begin{code}". (This is unchanged from the 98 Report) However the unlit.c implementation only matches a line that contains "\begin{code}" and nothing else. One consequence of this is that one cannot suffix Latex options to the code environment. I.e., this does not work: \begin{code}[label=foo,caption=Foo Code] Adjust the matcher to conform to the specification from the Report. The Haskell Wiki currently recommends suffixing a '%' to \begin{code} in order to deliberately hide a code block from Haskell. This is bad advice, as it's relying on an implementation quirk rather than specified behaviour. None-the-less, some people have tried to use it, c.f. <https://mail.haskell.org/pipermail/haskell-cafe/2009-September/066780.html> An alternative solution is to define a separate, equivalent Latex environment to "code", that is functionally identical in Latex but ignored by unlit. This should not be a burden: users are required to manually define the code environment anyway, as it is not provided by the Latex verbatim or lstlistings packages usually used for presenting code in documents. Fixes #3549. - - - - - 0b7fef11 by Teo Camarasu at 2022-11-23T12:44:33-05:00 Fix eventlog all option Previously it didn't enable/disable nonmoving_gc and ticky event types Fixes #21813 - - - - - 04d0618c by Arnaud Spiwack at 2022-11-23T12:45:14-05:00 Expand Note [Linear types] with the stance on linting linearity Per the discussion on #22123 - - - - - e1538516 by Lawton Nichols at 2022-11-23T12:45:55-05:00 Add documentation on custom Prelude modules (#22228) Specifically, custom Prelude modules that are named `Prelude`. - - - - - b5c71454 by Sylvain Henry at 2022-11-23T12:46:35-05:00 Don't let configure perform trivial substitutions (#21846) Hadrian now performs substitutions, especially to generate .cabal files from .cabal.in files. Two benefits: 1. We won't have to re-configure when we modify thing.cabal.in. Hadrian will take care of this for us. 2. It paves the way to allow the same package to be configured differently by Hadrian in the same session. This will be useful to fix #19174: we want to build a stage2 cross-compiler for the host platform and a stage1 compiler for the cross target platform in the same Hadrian session. - - - - - 99aca26b by nineonine at 2022-11-23T12:47:11-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043) Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043 - - - - - 040bfdc3 by M Farkas-Dyck at 2022-11-23T21:59:03-05:00 Scrub some no-warning pragmas. - - - - - 178c1fd8 by Vladislav Zavialov at 2022-11-23T21:59:39-05:00 Check if the SDoc starts with a single quote (#22488) This patch fixes pretty-printing of character literals inside promoted lists and tuples. When we pretty-print a promoted list or tuple whose first element starts with a single quote, we want to add a space between the opening bracket and the element: '[True] -- ok '[ 'True] -- ok '['True] -- not ok If we don't add the space, we accidentally produce a character literal '['. Before this patch, pprSpaceIfPromotedTyCon inspected the type as an AST and tried to guess if it would be rendered with a single quote. However, it missed the case when the inner type was itself a character literal: '[ 'x'] -- ok '['x'] -- not ok Instead of adding this particular case, I opted for a more future-proof solution: check the SDoc directly. This way we can detect if the single quote is actually there instead of trying to predict it from the AST. The new function is called spaceIfSingleQuote. - - - - - 11627c42 by Matthew Pickering at 2022-11-23T22:00:15-05:00 notes: Fix references to HPT space leak note Updating this note was missed when updating the HPT to the HUG. Fixes #22477 - - - - - 86ff1523 by Andrei Borzenkov at 2022-11-24T17:24:51-05:00 Convert diagnostics in GHC.Rename.Expr to proper TcRnMessage (#20115) Problem: avoid usage of TcRnMessageUnknown Solution: The following `TcRnMessage` messages has been introduced: TcRnNoRebindableSyntaxRecordDot TcRnNoFieldPunsRecordDot TcRnIllegalStaticExpression TcRnIllegalStaticFormInSplice TcRnListComprehensionDuplicateBinding TcRnEmptyStmtsGroup TcRnLastStmtNotExpr TcRnUnexpectedStatementInContext TcRnIllegalTupleSection TcRnIllegalImplicitParameterBindings TcRnSectionWithoutParentheses Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - d198a19a by Cheng Shao at 2022-11-24T17:25:29-05:00 rts: fix missing Arena.h symbols in RtsSymbols.c It was an unfortunate oversight in !8961 and broke devel2 builds. - - - - - 5943e739 by Bodigrim at 2022-11-25T04:38:28-05:00 Assorted fixes to avoid Data.List.{head,tail} - - - - - 1f1b99b8 by sheaf at 2022-11-25T04:38:28-05:00 Review suggestions for assorted fixes to avoid Data.List.{head,tail} - - - - - 13d627bb by Vladislav Zavialov at 2022-11-25T04:39:04-05:00 Print unticked promoted data constructors (#20531) Before this patch, GHC unconditionally printed ticks before promoted data constructors: ghci> type T = True -- unticked (user-written) ghci> :kind! T T :: Bool = 'True -- ticked (compiler output) After this patch, GHC prints ticks only when necessary: ghci> type F = False -- unticked (user-written) ghci> :kind! F F :: Bool = False -- unticked (compiler output) ghci> data False -- introduce ambiguity ghci> :kind! F F :: Bool = 'False -- ticked by necessity (compiler output) The old behavior can be enabled by -fprint-redundant-promotion-ticks. Summary of changes: * Rename PrintUnqualified to NamePprCtx * Add QueryPromotionTick to it * Consult the GlobalRdrEnv to decide whether to print a tick (see mkPromTick) * Introduce -fprint-redundant-promotion-ticks Co-authored-by: Artyom Kuznetsov <hi at wzrd.ht> - - - - - d10dc6bd by Simon Peyton Jones at 2022-11-25T22:31:27+00:00 Fix decomposition of TyConApps Ticket #22331 showed that we were being too eager to decompose a Wanted TyConApp, leading to incompleteness in the solver. To understand all this I ended up doing a substantial rewrite of the old Note [Decomposing equalities], now reborn as Note [Decomposing TyConApp equalities]. Plus rewrites of other related Notes. The actual fix is very minor and actually simplifies the code: in `can_decompose` in `GHC.Tc.Solver.Canonical.canTyConApp`, we now call `noMatchableIrreds`. A closely related refactor: we stop trying to use the same "no matchable givens" function here as in `matchClassInst`. Instead split into two much simpler functions. - - - - - 2da5c38a by Will Hawkins at 2022-11-26T04:05:04-05:00 Redirect output of musttail attribute test Compilation output from test for support of musttail attribute leaked to the console. - - - - - 0eb1c331 by Cheng Shao at 2022-11-28T08:55:53+00:00 Move hs_mulIntMayOflo cbits to ghc-prim It's only used by wasm NCG at the moment, but ghc-prim is a more reasonable place for hosting out-of-line primops. Also, we only need a single version of hs_mulIntMayOflo. - - - - - 36b53a9d by Cheng Shao at 2022-11-28T09:05:57+00:00 compiler: generate ccalls for clz/ctz/popcnt in wasm NCG We used to generate a single wasm clz/ctz/popcnt opcode, but it's wrong when it comes to subwords, so might as well generate ccalls for them. See #22470 for details. - - - - - d4134e92 by Cheng Shao at 2022-11-28T23:48:14-05:00 compiler: remove unused MO_U_MulMayOflo We actually only emit MO_S_MulMayOflo and never emit MO_U_MulMayOflo anywhere. - - - - - 8d15eadc by Apoorv Ingle at 2022-11-29T03:09:31-05:00 Killing cc_fundeps, streamlining kind equality orientation, and type equality processing order Fixes: #217093 Associated to #19415 This change * Flips the orientation of the the generated kind equality coercion in canEqLHSHetero; * Removes `cc_fundeps` in CDictCan as the check was incomplete; * Changes `canDecomposableTyConAppOk` to ensure we process kind equalities before type equalities and avoiding a call to `canEqLHSHetero` while processing wanted TyConApp equalities * Adds 2 new tests for validating the change - testsuites/typecheck/should_compile/T21703.hs and - testsuites/typecheck/should_fail/T19415b.hs (a simpler version of T19415.hs) * Misc: Due to the change in the equality direction some error messages now have flipped type mismatch errors * Changes in Notes: - Note [Fundeps with instances, and equality orientation] supercedes Note [Fundeps with instances] - Added Note [Kind Equality Orientation] to visualize the kind flipping - Added Note [Decomposing Dependent TyCons and Processing Wanted Equalties] - - - - - 646969d4 by Krzysztof Gogolewski at 2022-11-29T03:10:13-05:00 Change printing of sized literals to match the proposal Literals in Core were printed as e.g. 0xFF#16 :: Int16#. The proposal 451 now specifies syntax 0xFF#Int16. This change affects the Core printer only - more to be done later. Part of #21422. - - - - - 02e282ec by Simon Peyton Jones at 2022-11-29T03:10:48-05:00 Be a bit more selective about floating bottoming expressions This MR arranges to float a bottoming expression to the top only if it escapes a value lambda. See #22494 and Note [Floating to the top] in SetLevels. This has a generally beneficial effect in nofib +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || -0.93% | | imaginary/rfib || -0.05% | | real/fem || -0.03% | | real/fluid || -0.01% | | real/fulsom || +0.05% | | real/gamteb || -0.27% | | real/gg || -0.10% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/scs || -11.13% | | shootout/k-nucleotide || -0.01% | | shootout/n-body || -0.08% | | shootout/reverse-complement || -0.00% | | shootout/spectral-norm || -0.02% | | spectral/fibheaps || -0.20% | | spectral/hartel/fft || -1.04% | | spectral/hartel/solid || +0.33% | | spectral/hartel/wave4main || -0.35% | | spectral/mate || +0.76% | +===============================++==========+ | geom mean || -0.12% | The effect on compile time is generally slightly beneficial Metrics: compile_time/bytes allocated ---------------------------------------------- MultiLayerModulesTH_OneShot(normal) +0.3% PmSeriesG(normal) -0.2% PmSeriesT(normal) -0.1% T10421(normal) -0.1% T10421a(normal) -0.1% T10858(normal) -0.1% T11276(normal) -0.1% T11303b(normal) -0.2% T11545(normal) -0.1% T11822(normal) -0.1% T12150(optasm) -0.1% T12234(optasm) -0.3% T13035(normal) -0.2% T16190(normal) -0.1% T16875(normal) -0.4% T17836b(normal) -0.2% T17977(normal) -0.2% T17977b(normal) -0.2% T18140(normal) -0.1% T18282(normal) -0.1% T18304(normal) -0.2% T18698a(normal) -0.1% T18923(normal) -0.1% T20049(normal) -0.1% T21839r(normal) -0.1% T5837(normal) -0.4% T6048(optasm) +3.2% BAD T9198(normal) -0.2% T9630(normal) -0.1% TcPlugin_RewritePerf(normal) -0.4% hard_hole_fits(normal) -0.1% geo. mean -0.0% minimum -0.4% maximum +3.2% The T6048 outlier is hard to pin down, but it may be the effect of reading in more interface files definitions. It's a small program for which compile time is very short, so I'm not bothered about it. Metric Increase: T6048 - - - - - ab23dc5e by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Mark unpack_sums_6 as fragile due to #22504 This test is explicitly dependent upon runtime, which is generally not appropriate given that the testsuite is run in parallel and generally saturates the CPU. - - - - - def47dd3 by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Don't use grep -q in unpack_sums_7 `grep -q` closes stdin as soon as it finds the pattern it is looking for, resulting in #22484. - - - - - cc25d52e by Sylvain Henry at 2022-11-29T09:44:31+01:00 Add Javascript backend Add JS backend adapted from the GHCJS project by Luite Stegeman. Some features haven't been ported or implemented yet. Tests for these features have been disabled with an associated gitlab ticket. Bump array submodule Work funded by IOG. Co-authored-by: Jeffrey Young <jeffrey.young at iohk.io> Co-authored-by: Luite Stegeman <stegeman at gmail.com> Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 68c966cd by sheaf at 2022-11-30T09:31:25-05:00 Fix @since annotations on WithDict and Coercible Fixes #22453 - - - - - a3a8e9e9 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Be more careful in GHC.Tc.Solver.Interact.solveOneFromTheOther We were failing to account for the cc_pend_sc flag in this important function, with the result that we expanded superclasses forever. Fixes #22516. - - - - - a9d9b8c0 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Use mkNakedFunTy in tcPatSynSig As #22521 showed, in tcPatSynSig we make a "fake type" to kind-generalise; and that type has unzonked type variables in it. So we must not use `mkFunTy` (which checks FunTy's invariants) via `mkPhiTy` when building this type. Instead we need to use `mkNakedFunTy`. Easy fix. - - - - - 31462d98 by Andreas Klebinger at 2022-11-30T14:50:58-05:00 Properly cast values when writing/reading unboxed sums. Unboxed sums might store a Int8# value as Int64#. This patch makes sure we keep track of the actual value type. See Note [Casting slot arguments] for the details. - - - - - 10a2a7de by Oleg Grenrus at 2022-11-30T14:51:39-05:00 Move Void to GHC.Base... This change would allow `Void` to be used deeper in module graph. For example exported from `Prelude` (though that might be already possible). Also this change includes a change `stimes @Void _ x = x`, https://github.com/haskell/core-libraries-committee/issues/95 While the above is not required, maintaining old stimes behavior would be tricky as `GHC.Base` doesn't know about `Num` or `Integral`, which would require more hs-boot files. - - - - - b4cfa8e2 by Sebastian Graf at 2022-11-30T14:52:24-05:00 DmdAnal: Reflect the `seq` of strict fields of a DataCon worker (#22475) See the updated `Note [Data-con worker strictness]` and the new `Note [Demand transformer for data constructors]`. Fixes #22475. - - - - - d87f28d8 by Baldur Blöndal at 2022-11-30T21:16:36+01:00 Make Functor a quantified superclass of Bifunctor. See https://github.com/haskell/core-libraries-committee/issues/91 for discussion. This change relates Bifunctor with Functor by requiring second = fmap. Moreover this change is a step towards unblocking the major version bump of bifunctors and profunctors to major version 6. This paves the way to move the Profunctor class into base. For that Functor first similarly becomes a superclass of Profunctor in the new major version 6. - - - - - 72cf4c5d by doyougnu at 2022-12-01T12:36:44-05:00 FastString: SAT bucket_match Metric Decrease: MultiLayerModulesTH_OneShot - - - - - afc2540d by Simon Peyton Jones at 2022-12-01T12:37:20-05:00 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 - - - - - 81eeec7f by M Farkas-Dyck at 2022-12-01T12:37:56-05:00 CI: Forbid the fully static build on Alpine to fail. To do so, we mark some tests broken in this configuration. - - - - - c5d1bf29 by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Remove ARMv7 jobs These jobs fail (and are allowed to fail) nearly every time. Soon they won't even be able to run at all, as we won't currently have runners that can run them. Fixing the latter problem is tracked in #22409. I went ahead and removed all settings and configurations. - - - - - d82992fd by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Fix CI lint Failure was introduced by conflicting changes to gen_ci.hs that did *not* trigger git conflicts. - - - - - ce126993 by Simon Peyton Jones at 2022-12-02T01:22:12-05:00 Refactor TyCon to have a top-level product This patch changes the representation of TyCon so that it has a top-level product type, with a field that gives the details (newtype, type family etc), #22458. Not much change in allocation, but execution seems to be a bit faster. Includes a change to the haddock submodule to adjust for API changes. - - - - - 74c767df by Matthew Pickering at 2022-12-02T01:22:48-05:00 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 - - - - - 85ecc1a0 by Matthew Pickering at 2022-12-02T19:46:43-05:00 Add special case for :Main module in `GHC.IfaceToCore.mk_top_id` See Note [Root-main Id] The `:Main` special binding is actually defined in the current module (hence don't go looking for it externally) but the module name is rOOT_MAIN rather than the current module so we need this special case. There was already some similar logic in `GHC.Rename.Env` for External Core, but now the "External Core" is in interface files it needs to be moved here instead. Fixes #22405 - - - - - 108c319f by Krzysztof Gogolewski at 2022-12-02T19:47:18-05:00 Fix linearity checking in Lint Lint was not able to see that x*y <= x*y, because this inequality was decomposed to x <= x*y && y <= x*y, but there was no rule to see that x <= x*y. Fixes #22546. - - - - - bb674262 by Bryan Richter at 2022-12-03T04:38:46-05:00 Mark T16916 fragile See https://gitlab.haskell.org/ghc/ghc/-/issues/16966 - - - - - 5d267d46 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 Refactor: FreshOrReuse instead of addTyClTyVarBinds This is a refactoring that should have no effect on observable behavior. Prior to this change, GHC.HsToCore.Quote contained a few closely related functions to process type variable bindings: addSimpleTyVarBinds, addHsTyVarBinds, addQTyVarBinds, and addTyClTyVarBinds. We can classify them by their input type and name generation strategy: Fresh names only Reuse bound names +---------------------+-------------------+ [Name] | addSimpleTyVarBinds | | [LHsTyVarBndr flag GhcRn] | addHsTyVarBinds | | LHsQTyVars GhcRn | addQTyVarBinds | addTyClTyVarBinds | +---------------------+-------------------+ Note how two functions are missing. Because of this omission, there were two places where a LHsQTyVars value was constructed just to be able to pass it to addTyClTyVarBinds: 1. mk_qtvs in addHsOuterFamEqnTyVarBinds -- bad 2. mkHsQTvs in repFamilyDecl -- bad This prevented me from making other changes to LHsQTyVars, so the main goal of this refactoring is to get rid of those workarounds. The most direct solution would be to define the missing functions. But that would lead to a certain amount of code duplication. To avoid code duplication, I factored out the name generation strategy into a function parameter: data FreshOrReuse = FreshNamesOnly | ReuseBoundNames addSimpleTyVarBinds :: FreshOrReuse -> ... addHsTyVarBinds :: FreshOrReuse -> ... addQTyVarBinds :: FreshOrReuse -> ... - - - - - c189b831 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 addHsOuterFamEqnTyVarBinds: use FreshNamesOnly for explicit binders Consider this example: [d| instance forall a. C [a] where type forall b. G [a] b = Proxy b |] When we process "forall b." in the associated type instance, it is unambiguously the binding site for "b" and we want a fresh name for it. Therefore, FreshNamesOnly is more fitting than ReuseBoundNames. This should not have any observable effect but it avoids pointless lookups in the MetaEnv. - - - - - 42512264 by Ross Paterson at 2022-12-03T10:32:45+00:00 Handle type data declarations in Template Haskell quotations and splices (fixes #22500) This adds a TypeDataD constructor to the Template Haskell Dec type, and ensures that the constructors it contains go in the TyCls namespace. - - - - - 1a767fa3 by Vladislav Zavialov at 2022-12-05T05:18:50-05:00 Add BufSpan to EpaLocation (#22319, #22558) The key part of this patch is the change to mkTokenLocation: - mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb) mkTokenLocation used to discard the BufSpan, but now it is saved and can be retrieved from LHsToken or LHsUniToken. This is made possible by the following change to EpaLocation: - data EpaLocation = EpaSpan !RealSrcSpan + data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | ... The end goal is to make use of the BufSpan in Parser/PostProcess/Haddock. - - - - - cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 46acc22f by Ben Gamari at 2023-02-23T15:53:05-05:00 base: Factor out errorBelch This was useful when debugging - - - - - 4e2c707d by Ben Gamari at 2023-02-23T15:53:05-05:00 base: Clean up imports of GHC.ExecutionStack - - - - - e2517aa6 by Ben Gamari at 2023-02-23T15:53:05-05:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - 5b3328d5 by Ben Gamari at 2023-02-23T15:53:05-05:00 base: Move prettyCallStack to GHC.Stack - - - - - d43ee986 by Ben Gamari at 2023-02-23T15:53:05-05:00 base: Move PrimMVar to GHC.MVar - - - - - 508a7a41 by Ben Gamari at 2023-02-23T15:53:05-05:00 base: Use displayException in top-level exception handler Happily this also allows us to eliminate a special case for Deadlock exceptions. - - - - - 3c4b2ef8 by Ben Gamari at 2023-02-23T16:10:33-05:00 base: Introduce exception context - - - - - f59857ce by Ben Gamari at 2023-03-09T15:01:40-05:00 Use toException instead of SomeException - - - - - 6c86cef2 by Ben Gamari at 2023-03-09T15:02:08-05:00 backtraceDesired - - - - - e3177326 by Ben Gamari at 2023-03-09T15:15:43-05:00 Fixes - - - - - 76e9bb4b by Ben Gamari at 2023-03-09T15:30:20-05:00 Drop hs-boot declarations - - - - - e88b2b63 by Ben Gamari at 2023-03-11T14:25:07-05:00 Default ExceptionContext - - - - - c94c45f0 by Ben Gamari at 2023-03-11T14:25:24-05:00 Small optimisation of evCallStack Don't lookupIds unless we actually need them. - - - - - 907af9f8 by Ben Gamari at 2023-03-11T14:28:28-05:00 Drop redundant import - - - - - c563563f by Ben Gamari at 2023-03-11T18:14:41-05:00 warning - - - - - 12 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - + .gitlab/hello.hs - + .gitlab/hie.yaml - .gitlab/jobs.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/445b0a320b7f299d003bcceb7a4f8d621263dd1d...c563563f247196096414023d36f9fdf9a5d60ea1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/445b0a320b7f299d003bcceb7a4f8d621263dd1d...c563563f247196096414023d36f9fdf9a5d60ea1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 12 02:16:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 11 Mar 2023 21:16:09 -0500 Subject: [Git][ghc/ghc] Pushed new tag ghc-9.6.1-release Message-ID: <640d35e9bc25b_36ed6c2a875e2c3336cb@gitlab.mail> Ben Gamari pushed new tag ghc-9.6.1-release at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.6.1-release You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 12 07:04:09 2023 From: gitlab at gitlab.haskell.org (Peter Trommler (@trommler)) Date: Sun, 12 Mar 2023 03:04:09 -0400 Subject: [Git][ghc/ghc][wip/T21191] 197 commits: Update JavaScript fileStat to match Emscripten layout Message-ID: <640d79695c7c_36ed6c2f17064033688c@gitlab.mail> Peter Trommler pushed to branch wip/T21191 at Glasgow Haskell Compiler / GHC Commits: b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 8ce6fdc7 by Peter Trommler at 2023-03-12T08:03:34+01:00 PPC: Support ELF v2 on powerpc64 big-endian Detect ELF v2 on PowerPC 64-bit systems. Check for `_CALL_ELF` preprocessor macro. Fixes #21191 - - - - - fcb79fa7 by Sylvain Henry at 2023-03-12T08:03:34+01:00 Fix copy-paste - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - cabal.project-reinstall - compile_flags.txt - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/85fe2fa3b299eda5ea9fdcd6cfba9930efab1fcf...fcb79fa7121865a33ed2a52912499884ce842d6b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/85fe2fa3b299eda5ea9fdcd6cfba9930efab1fcf...fcb79fa7121865a33ed2a52912499884ce842d6b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 12 11:02:15 2023 From: gitlab at gitlab.haskell.org (ase (@adamse)) Date: Sun, 12 Mar 2023 07:02:15 -0400 Subject: [Git][ghc/ghc][wip/adamse/eventlog-docs] 2 commits: docs: add BlockedOnMVarRead thread status in eventlog encodings Message-ID: <640db13766448_36ed6c32ae1d5c34643e@gitlab.mail> ase pushed to branch wip/adamse/eventlog-docs at Glasgow Haskell Compiler / GHC Commits: d275b182 by Adam Sandberg Ericsson at 2023-03-12T11:01:40+00:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - ab4ef9cc by Adam Sandberg Ericsson at 2023-03-12T11:02:11+00:00 docs: add TASK_DELETE event in evenlog encodings - - - - - 1 changed file: - docs/users_guide/eventlog-formats.rst Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -164,6 +164,7 @@ Thread and scheduling events * 12: BlockedOnSTM * 13: BlockedOnDoProc * 16: BlockedOnMsgThrowTo + * 20: BlockedOnMVarRead :field ThreadId: thread id of thread being blocked on (only for some status values) @@ -538,6 +539,15 @@ Task events Marks the migration of a task to a new capability. +.. event-type:: TASK_DELETE + + :tag: 57 + :length: fixed + :field TaskId: task id + + Marks the deletion of a task. + + Tracing events ~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/70ebd2b731677194883e20319ce9b66c8a829f91...ab4ef9cc0c5dccb6a1e1f7784ea83d88261f7561 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/70ebd2b731677194883e20319ce9b66c8a829f91...ab4ef9cc0c5dccb6a1e1f7784ea83d88261f7561 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 12 11:26:14 2023 From: gitlab at gitlab.haskell.org (ase (@adamse)) Date: Sun, 12 Mar 2023 07:26:14 -0400 Subject: [Git][ghc/ghc][wip/adamse/eventlog-docs] docs: add WALL_CLOCK_TIME event in evenlog encodings Message-ID: <640db6d6dcfff_36ed6c330da3a834684b@gitlab.mail> ase pushed to branch wip/adamse/eventlog-docs at Glasgow Haskell Compiler / GHC Commits: 91fc54c3 by Adam Sandberg Ericsson at 2023-03-12T11:26:09+00:00 docs: add WALL_CLOCK_TIME event in evenlog encodings - - - - - 1 changed file: - docs/users_guide/eventlog-formats.rst Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -122,6 +122,18 @@ environment which the program is being run in. Describes the environment variables present in the program's environment. +.. event-type:: WALL_CLOCK_TIME + + :tag: 43 + :length: fixed + :field CapSetId: Capability set + :field Word64: Unix epoch seconds + :field Word32: Nanoseconds + + Records the wall clock time to make it possible to correlate events from + elsewhere with the eventlog. + + Thread and scheduling events ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91fc54c328b241b3a3595dbeb5c2cd21571d3eee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91fc54c328b241b3a3595dbeb5c2cd21571d3eee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 12 11:27:28 2023 From: gitlab at gitlab.haskell.org (ase (@adamse)) Date: Sun, 12 Mar 2023 07:27:28 -0400 Subject: [Git][ghc/ghc][wip/adamse/eventlog-docs] 2 commits: docs: add TASK_DELETE event in eventlog encodings Message-ID: <640db720697d7_36ed6c3329cb8c349227@gitlab.mail> ase pushed to branch wip/adamse/eventlog-docs at Glasgow Haskell Compiler / GHC Commits: afa38d84 by Adam Sandberg Ericsson at 2023-03-12T11:26:50+00:00 docs: add TASK_DELETE event in eventlog encodings - - - - - 50226c6d by Adam Sandberg Ericsson at 2023-03-12T11:27:13+00:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - 1 changed file: - docs/users_guide/eventlog-formats.rst Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -122,6 +122,18 @@ environment which the program is being run in. Describes the environment variables present in the program's environment. +.. event-type:: WALL_CLOCK_TIME + + :tag: 43 + :length: fixed + :field CapSetId: Capability set + :field Word64: Unix epoch seconds + :field Word32: Nanoseconds + + Records the wall clock time to make it possible to correlate events from + elsewhere with the eventlog. + + Thread and scheduling events ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -539,6 +551,15 @@ Task events Marks the migration of a task to a new capability. +.. event-type:: TASK_DELETE + + :tag: 57 + :length: fixed + :field TaskId: task id + + Marks the deletion of a task. + + Tracing events ~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91fc54c328b241b3a3595dbeb5c2cd21571d3eee...50226c6d0ca087c182c072247895cf75ceea2a92 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91fc54c328b241b3a3595dbeb5c2cd21571d3eee...50226c6d0ca087c182c072247895cf75ceea2a92 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 00:32:45 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 12 Mar 2023 20:32:45 -0400 Subject: [Git][ghc/ghc][wip/T22194] Wibbles Message-ID: <640e6f2da0b95_36ed6c3f4ebabc374951@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194 at Glasgow Haskell Compiler / GHC Commits: 26ce990b by Simon Peyton Jones at 2023-03-13T00:33:45+00:00 Wibbles - - - - - 7 changed files: - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1534,21 +1534,20 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco | TyVarLHS tv1 <- lhs1 , TyVarLHS tv2 <- lhs2 - , swapOverTyVars (isGiven ev) tv1 tv2 = do { traceTcS "canEqLHS2 swapOver" (ppr tv1 $$ ppr tv2 $$ ppr swapped) - ; new_ev <- do_swap - ; canEqCanLHSFinish new_ev eq_rel IsSwapped (TyVarLHS tv2) - (ps_xi1 `mkCastTyMCo` sym_mco) } + ; if swapOverTyVars (isGiven ev) tv1 tv2 + then finish_with_swapping + else finish_without_swapping } - | TyVarLHS tv1 <- lhs1 - , TyFamLHS fun_tc2 fun_args2 <- lhs2 - = canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco + -- See Note [Always put TyVarLHS on the left] + | TyVarLHS {} <- lhs1 + , TyFamLHS {} <- lhs2 + = finish_without_swapping - | TyFamLHS fun_tc1 fun_args1 <- lhs1 - , TyVarLHS tv2 <- lhs2 - = do { new_ev <- do_swap - ; canEqTyVarFunEq new_ev eq_rel IsSwapped tv2 ps_xi2 - fun_tc1 fun_args1 ps_xi1 sym_mco } + -- See Note [Always put TyVarLHS on the left] + | TyFamLHS {} <- lhs1 + , TyVarLHS {} <- lhs2 + = finish_with_swapping | TyFamLHS fun_tc1 fun_args1 <- lhs1 , TyFamLHS fun_tc2 fun_args2 <- lhs2 @@ -1604,7 +1603,8 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -- this check is just to avoid unfruitful swapping swap_for_occurs = False -{- + +{- ToDo: not sure about this -- If we have F a ~ F (F a), we want to swap. swap_for_occurs | cterHasNoProblem $ checkTyFamEq fun_tc2 fun_args2 @@ -1617,55 +1617,34 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco -} ; if swap_for_rewriting || swap_for_occurs - then do { new_ev <- do_swap - ; canEqCanLHSFinish new_ev eq_rel IsSwapped lhs2 (ps_xi1 `mkCastTyMCo` sym_mco) } + then finish_with_swapping else finish_without_swapping } - - -- that's all the special cases. Now we just figure out which non-special case - -- to continue to. - | otherwise - = finish_without_swapping - where sym_mco = mkSymMCo mco - do_swap = rewriteCastedEquality ev eq_rel swapped (canEqLHSType lhs1) (canEqLHSType lhs2) mco - finish_without_swapping = canEqCanLHSFinish ev eq_rel swapped lhs1 (ps_xi2 `mkCastTyMCo` mco) - - --- This function handles the case where one side is a tyvar and the other is --- a type family application. Which to put on the left? --- If the tyvar is a touchable meta-tyvar, put it on the left, as this may --- be our only shot to unify. --- Otherwise, put the function on the left, because it's generally better to --- rewrite away function calls. This makes types smaller. And it seems necessary: --- [W] F alpha ~ alpha --- [W] F alpha ~ beta --- [W] G alpha beta ~ Int ( where we have type instance G a a = a ) --- If we end up with a stuck alpha ~ F alpha, we won't be able to solve this. --- Test case: indexed-types/should_compile/CEqCanOccursCheck -canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) - -- or (rhs |> mco) ~ lhs if swapped - -> EqRel -> SwapFlag - -> TyVar -> TcType -- lhs (or if swapped rhs), pretty lhs - -> TyCon -> [Xi] -> TcType -- rhs (or if swapped lhs) fun and args, pretty rhs - -> MCoercion -- :: kind(rhs) ~N kind(lhs) - -> TcS (StopOrContinue Ct) -canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco - = do { given_eq_lvl <- getInnermostGivenEqLevel - ; if | touchabilityTest given_eq_lvl tv1 rhs -- alpha ~ F tys, alpha touchable - -> canEqCanLHSFinish ev eq_rel swapped (TyVarLHS tv1) rhs - - | otherwise -- F tys ~ alpha - -> do { new_ev <- rewriteCastedEquality ev eq_rel swapped - (mkTyVarTy tv1) (mkTyConApp fun_tc2 fun_args2) - mco - ; canEqCanLHSFinish new_ev eq_rel IsSwapped - (TyFamLHS fun_tc2 fun_args2) - (ps_xi1 `mkCastTyMCo` sym_mco) } } - where - sym_mco = mkSymMCo mco - rhs = ps_xi2 `mkCastTyMCo` mco + finish_without_swapping + = canEqCanLHSFinish ev eq_rel swapped lhs1 (ps_xi2 `mkCastTyMCo` mco) + finish_with_swapping + = do { new_ev <- rewriteCastedEquality ev eq_rel swapped + (canEqLHSType lhs1) (canEqLHSType lhs2) mco + ; canEqCanLHSFinish new_ev eq_rel IsSwapped lhs2 (ps_xi1 `mkCastTyMCo` sym_mco) } + +{- Note [Always put TyVarLHS on the left] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +What if one side is a tyvar and the other is a type family +application, (a ~ F tys) ? Which to put on the left? Answer: +* Put the tyvar on the left, (a ~ F tys) as this may be our only shot to unify. +* But if we fail to unify and end up in cantMakeCanonical, + then flip back to (F tys ~ a) because it's generally better + to rewrite away function calls. This makes types smaller. + +It's important to flip back. Consider + [W] F alpha ~ alpha + [W] F alpha ~ beta + [W] G alpha beta ~ Int ( where we have type instance G a a = a ) + If we end up with a stuck alpha ~ F alpha, we won't be able to solve this. + Test case: indexed-types/should_compile/CEqCanOccursCheck +-} -- The RHS here is either not CanEqLHS, or it's one that we -- want to rewrite the LHS to (as per e.g. swapOverTyVars) @@ -1685,8 +1664,14 @@ canEqCanLHSFinish, canEqCanLHSFinish_try_unification, --------------------------- canEqCanLHSFinish ev eq_rel swapped lhs rhs - = do { -- Assertion: (TyEq:K) is already satisfied - massert (canEqLHSKind lhs `eqType` typeKind rhs) + = do { traceTcS "canEqCanLHSFinish" $ + vcat [ text "ev:" <+> ppr ev + , text "swapped:" <+> ppr swapped + , text "lhs:" <+> ppr lhs + , text "rhs:" <+> ppr rhs ] + + -- Assertion: (TyEq:K) is already satisfied + ; massert (canEqLHSKind lhs `eqType` typeKind rhs) -- Assertion: (TyEq:N) is already satisfied (if applicable) ; assertPprM ty_eq_N_OK $ @@ -1724,11 +1709,13 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs then canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs else + -- We have a touchable unification variable on the left do { check_result <- checkTouchableTyVarEq ev tv rhs ; case check_result of { PuFail reason -> cantMakeCanonical reason ev eq_rel swapped lhs rhs ; PuOK redn _ -> + -- Success: we can solve by unification do { let tv_ty = mkTyVarTy tv final_rhs = reductionReducedType redn tv_lvl = tcTyVarLevel tv @@ -1778,15 +1765,27 @@ canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs do { new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped (mkReflRedn Nominal (canEqLHSType lhs)) rhs_redn - ; ics <- getInertCans - ; interactEq ics (EqCt { eq_ev = new_ev, eq_eq_rel = eq_rel - , eq_lhs = lhs, eq_rhs = rhs }) }}} + ; interactEq (EqCt { eq_ev = new_ev, eq_eq_rel = eq_rel + , eq_lhs = lhs + , eq_rhs = reductionReducedType rhs_redn }) }}} ---------------------- cantMakeCanonical :: CheckTyEqResult -> CtEvidence -> EqRel -> SwapFlag -> CanEqLHS -> TcType -> TcS (StopOrContinue Ct) cantMakeCanonical reason ev eq_rel swapped lhs rhs + | TyVarLHS tv <- lhs + , Just (tc,tys) <- splitTyConApp_maybe rhs + , isFamilyTyCon tc + , let lhs_ty = mkTyVarTy tv + = -- Flip (a ~ F tys) to (F tys ~ a) + do { new_ev <- rewriteEqEvidence emptyRewriterSet ev (flipSwap swapped) + (mkReflRedn role rhs) (mkReflRedn role lhs_ty) + ; interactEq (EqCt { eq_ev = new_ev, eq_eq_rel = eq_rel + , eq_lhs = TyFamLHS tc tys + , eq_rhs = lhs_ty }) } + + | otherwise = do { traceTcS "cantMakeCanonical" (ppr lhs $$ ppr rhs) ; new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped (mkReflRedn role (canEqLHSType lhs)) (mkReflRedn role rhs) @@ -2386,24 +2385,24 @@ But it's not so simple: call to strictly_more_visible. -} -interactEq :: InertCans -> EqCt -> TcS (StopOrContinue Ct) -interactEq inerts - work_item@(EqCt { eq_lhs = lhs, eq_ev = ev, eq_eq_rel = eq_rel }) - - | Just (ev_i, swapped) <- inertsCanDischarge inerts work_item - = do { setEvBindIfWanted ev IsCoherent $ - evCoercion (maybeSymCo swapped $ - downgradeRole (eqRelRole eq_rel) - (ctEvRole ev_i) - (ctEvCoercion ev_i)) - ; stopWith ev "Solved from inert" } - - | otherwise - = case lhs of - TyVarLHS {} -> finishEqCt work_item - TyFamLHS tc args -> do { improveLocalFunEqs inerts tc args work_item - ; improveTopFunEqs tc args work_item - ; finishEqCt work_item } +interactEq :: EqCt -> TcS (StopOrContinue Ct) +interactEq work_item@(EqCt { eq_lhs = lhs, eq_ev = ev, eq_eq_rel = eq_rel }) + + = do { inerts <- getInertCans + ; if | Just (ev_i, swapped) <- inertsCanDischarge inerts work_item + -> do { setEvBindIfWanted ev IsCoherent $ + evCoercion (maybeSymCo swapped $ + downgradeRole (eqRelRole eq_rel) + (ctEvRole ev_i) + (ctEvCoercion ev_i)) + ; stopWith ev "Solved from inert" } + + | otherwise + -> case lhs of + TyVarLHS {} -> finishEqCt work_item + TyFamLHS tc args -> do { improveLocalFunEqs inerts tc args work_item + ; improveTopFunEqs tc args work_item + ; finishEqCt work_item } } inertsCanDischarge :: InertCans -> EqCt ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -115,13 +115,10 @@ module GHC.Tc.Solver.Monad ( getDefaultInfo, getDynFlags, getGlobalRdrEnvTcS, matchFam, matchFamTcM, checkWellStagedDFun, - pprEq, -- Smaller utils, re-exported from TcM - -- TODO (DV): these are only really used in the - -- instance matcher in GHC.Tc.Solver. I am wondering - -- if the whole instance matcher simply belongs - -- here + pprEq, - checkTypeEq, checkTouchableTyVarEq, rewriterView + -- Enforcing invariants for type equalities + checkTypeEq, checkTouchableTyVarEq ) where import GHC.Prelude @@ -169,7 +166,6 @@ import GHC.Types.Name.Reader import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Unique.Supply -import GHC.Types.Unique.Set (nonDetEltsUniqSet) import GHC.Unit.Module ( HasModule, getModule, extractModule ) import qualified GHC.Rename.Env as TcM @@ -193,6 +189,7 @@ import Data.Foldable import qualified Data.Semigroup as S #if defined(DEBUG) +import GHC.Types.Unique.Set (nonDetEltsUniqSet) import GHC.Data.Graph.Directed #endif @@ -2070,39 +2067,189 @@ checkTouchableTyVarEq -> TcTyVar -- A touchable meta-tyvar -> TcType -- The RHS -> TcS (PuResult () Reduction) --- Only used for Nominal, Wanted equalities, with a touchble meta-tyvar on LHS +-- Used for Nominal, Wanted equalities, with a touchble meta-tyvar on LHS -- If checkTouchableTyVarEq tv ty = PuOK redn cts -- then we can unify -- tv := ty |> redn -- with extra wanteds 'cts' --- --- If it returns (Left reason) we can't unify, and the reason explains why. -checkTouchableTyVarEq ev tv rhs - | MetaTv { mtv_info = tv_info, mtv_tclvl = tv_lvl } <- tcTyVarDetails tv - = do { check_result :: PuResult Ct Reduction - <- wrapTcS $ checkTyEqRhs ghci_tv - (flattenWantedFamApp ev tv_lvl) - (checkTvUnif tv tv_info tv_lvl) - (checkCoUnif tv) - rhs +-- If it returns (PuFail reason) we can't unify, and the reason explains why. +checkTouchableTyVarEq ev lhs_tv rhs + | MetaTv { mtv_info = lhs_tv_info, mtv_tclvl = lhs_tv_lvl } <- tcTyVarDetails lhs_tv + = do { traceTcS "checkTouchableTyVarEq" (ppr lhs_tv $$ ppr rhs) + ; check_result <- wrapTcS (check_rhs lhs_tv_info lhs_tv_lvl) + ; traceTcS "checkTouchableTyVarEq 2" (ppr lhs_tv $$ ppr check_result) ; case check_result of PuFail reason -> return (PuFail reason) PuOK redn cts -> do { emitWork (bagToList cts) ; return (pure redn) } } - -- Only called on meta-tyvars - | otherwise = pprPanic "checkTouchableTyVarEq" (ppr tv) + + | otherwise = pprPanic "checkTouchableTyVarEq" (ppr lhs_tv) + where + ghci_tv = isRuntimeUnkSkol lhs_tv + + check_rhs lhs_tv_info lhs_tv_lvl = case coreFullView rhs of + TyConApp tc tys | isTypeFamilyTyCon tc + , not (isConcreteTyVar lhs_tv) + -> -- Special case for lhs ~ F tys + -- We don't want to flatten that (F tys) + do { tys_res <- mapCheck (simple_check lhs_tv_lvl) tys + ; return (mkTyConAppRedn Nominal tc <$> tys_res) } + + -- Normal case + _other -> checkTyEqRhs ghci_tv + (checkTvUnif lhs_tv lhs_tv_info lhs_tv_lvl) + (check_fam_app lhs_tv_lvl) + (checkCoUnif lhs_tv lhs_tv_lvl) + rhs + + simple_check lhs_tv_lvl = simpleCheckRhs lhs_tv (UnifyingAt lhs_tv_lvl) + + check_fam_app :: TcLevel -> TcType -> TyCon -> [TcType] + -> TcM (PuResult Ct Reduction) + check_fam_app lhs_tv_lvl fam_app_ty tc tys + | isConcreteTyVar lhs_tv + = failCheckWith (cteProblem cteConcrete) + + | otherwise + = -- Try just checking the arguments + do { tys_res <- mapCheck (simple_check lhs_tv_lvl) tys + ; case tys_res of { + PuOK redns _ -> return (PuOK (mkTyConAppRedn Nominal tc redns) emptyCts) ; + PuFail {} -> + + -- Occurs check or skolem escape; so flatten + do { new_tv_ty <- TcM.newMetaTyVarTyAtLevel lhs_tv_lvl (typeKind fam_app_ty) + ; let pty = mkPrimEqPredRole Nominal fam_app_ty new_tv_ty + ; hole <- TcM.newCoercionHole pty + ; let new_ev = CtWanted { ctev_pred = pty + , ctev_dest = HoleDest hole + , ctev_loc = cb_loc + , ctev_rewriters = ctEvRewriters ev } + ; return (PuOK (mkReduction (HoleCo hole) new_tv_ty) + (singleCt (mkNonCanonical new_ev))) }}} + + -- See Detail (7) of the Note + cb_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin + +------------------------- +checkTvUnif :: TcTyVar -> MetaInfo -> TcLevel -- The LHS tv, a touchable meta tvar + -> TcTyVar -- An occurrence of a tyvar in the RHS + -> TcM (PuResult a Reduction) +checkTvUnif lhs_tv lhs_tv_info lhs_tv_lvl occ_tv + | lhs_tv == occ_tv + = failCheckWith insolubleOccursProblem + -- Unification is always Nominal, so no faffing + -- with Note [Occurs check and representational equality] + + | MetaTv { mtv_info = info_occ, mtv_tclvl = lvl_occ } <- occ_details + = do { mb_done <- TcM.isFilledMetaTyVar_maybe occ_tv + ; case mb_done of + Just ty -> okCheckRefl ty -- Already promoted; job done + Nothing -> check_tv occ_tv info_occ lvl_occ } + + | SkolemTv _ lvl_occ _ <- occ_details + , need_to_promote lvl_occ -- Skolem tyvar that needs promotion; skolem escape + = failCheckWith (cteProblem cteSkolemEscape) + + | otherwise + = okCheckRefl (mkTyVarTy occ_tv) where - ghci_tv = isRuntimeUnkSkol tv + occ_details = tcTyVarDetails occ_tv + + check_tv occ_tv info_occ lvl_occ + | not (need_to_promote lvl_occ) + , not (need_to_make_concrete info_occ) + = okCheckRefl (mkTyVarTy occ_tv) -- No-op + + | lhs_tv_is_concrete + , cant_make_concrete info_occ + = failCheckWith (cteProblem cteConcrete) -- E.g. alpha[conc] := Maybe beta[tv] + | otherwise + = do { let new_info | lhs_tv_is_concrete = lhs_tv_info + | otherwise = info_occ + new_lvl = lhs_tv_lvl `minTcLevel` lvl_occ + -- c[conc,3] ~ p[tau,2]: want to clone p:=p'[conc,2] + -- c[tau,2] ~ p[tau,3]: want to clone p:=p'[tau,2] + ; reason <- checkFreeVars lhs_tv lhs_tv_lvl (tyCoVarsOfType (tyVarKind occ_tv)) + ; if cterHasNoProblem reason -- Successfully promoted + then do { new_tv_ty <- promote_meta_tyvar new_info new_lvl occ_tv + ; okCheckRefl new_tv_ty } + else failCheckWith reason } + + need_to_promote lvl_occ = lvl_occ `strictlyDeeperThan` lhs_tv_lvl + need_to_make_concrete info_occ = lhs_tv_is_concrete && + not (isConcreteInfo info_occ) + + cant_make_concrete (ConcreteTv {}) = False + cant_make_concrete TauTv = False + cant_make_concrete _ = True + -- Don't attempt to make other type variables concrete + -- (e.g. SkolemTv, TyVarTv, CycleBreakerTv, RuntimeUnkTv). + + lhs_tv_is_concrete = isConcreteInfo lhs_tv_info + +------------------------- +checkCoUnif :: TcTyVar -> TcLevel -> TcCoercion -> TcM (PuResult a TcCoercion) +-- No bother about impredicativity in coercions, as they're inferred +-- Don't check coercions for type families; see commentary at top of function +checkCoUnif lhs_tv lhs_tv_lvl co + | hasCoercionHoleCo co = failCheckWith (cteProblem cteCoercionHole) + | otherwise = do { reason <- checkFreeVars lhs_tv lhs_tv_lvl (tyCoVarsOfCo co) + ; if cterHasNoProblem reason + then return (pure co) + else failCheckWith reason } + +-------------------------- +simpleCheckRhs :: TcTyVar -> AreUnifying + -> TcType -> TcM (PuResult a Reduction) +-- Used under a type family application +-- Occurrence check and level check +-- (failing with skolem-escape for the latter) +simpleCheckRhs lhs_tv are_unifying + = checkTyEqRhs False {- No foralls -} + (simpleCheckTv lhs_tv are_unifying) + (simpleCheckFamApp lhs_tv are_unifying) + (simpleCheckCo lhs_tv (areUnifying are_unifying)) + + +simpleCheckTv :: TcTyVar -- LHS tyvar + -> AreUnifying -- Just lvl => we are unifying lhs tyvar with level lvl + -> TcTyVar -> TcM (PuResult a Reduction) +-- Used under a type-family application +simpleCheckTv lhs_tv are_unifying occ_tv + -- Occurs check + | occursCheckTv lhs_tv occ_tv + = failCheckWith insolubleOccursProblem + + -- Level check if we are unifying + | UnifyingAt lhs_tv_lvl <- are_unifying + , tcTyVarLevel occ_tv `strictlyDeeperThan` lhs_tv_lvl + = failCheckWith (cteProblem cteSkolemEscape) + + -- Otherwise all is good + | otherwise + = okCheckRefl (mkTyVarTy occ_tv) + +simpleCheckFamApp :: TcTyVar -> AreUnifying + -> TcType -> TyCon -> [TcType] + -> TcM (PuResult a Reduction) +-- Just recurse into the arguments; no flattening or anything +simpleCheckFamApp lhs_tv are_unifying _fam_app_ty tc tys + = do { tys_res <- mapCheck (simpleCheckRhs lhs_tv are_unifying) tys + ; return (mkTyConAppRedn Nominal tc <$> tys_res) } + +------------------------ checkTypeEq :: CtEvidence -> EqRel -> CanEqLHS -> TcType -> TcS (PuResult () Reduction) -- Used for general CanEqLHSs, ones that do -- not have a touchable type variable on the LHS +-- +-- For Givens, flatten to avoid an occurs-check +-- For Wanteds, don't bother checkTypeEq ev eq_rel lhs rhs | isGiven ev - = do { check_result :: PuResult (TcTyVar,TcType) Reduction - <- wrapTcS $ checkTyEqRhs ghci_tv flattenGivenFamApp - check_tv check_co rhs + = do { check_result <- wrapTcS (check_given rhs) ; case check_result of PuFail reason -> return (PuFail reason) PuOK redn prs -> do { let prs_list = bagToList prs @@ -2112,37 +2259,52 @@ checkTypeEq ev eq_rel lhs rhs ; return (pure redn) } } | otherwise -- Wanted - = do { tc_lvl <- getTcLevel - ; check_result :: PuResult Ct Reduction - <- wrapTcS $ checkTyEqRhs ghci_tv (flattenWantedFamApp ev tc_lvl) - check_tv check_co rhs + = do { check_result <- wrapTcS (check_wanted rhs) ; case check_result of PuFail reason -> return (PuFail reason) PuOK redn cts -> do { emitWork (bagToList cts) ; return (pure redn) } } where - ghci_tv = False - -- check_tv: unification is off the table, so we don't need a level check - check_tv :: TcTyVar -> TcM (PuResult a Reduction) - check_tv = case lhs of - TyFamLHS {} -> \tv -> okCheckRefl (mkTyVarTy tv) - TyVarLHS lhs_tv -> occ_check_tv lhs_tv - - check_co :: TcCoercion -> TcM (PuResult a Coercion) - check_co = case lhs of - TyFamLHS {} -> \co -> return (pure co) - TyVarLHS lhs_tv -> occ_check_co lhs_tv - - occ_check_tv :: TcTyVar -> TcTyVar -> TcM (PuResult a Reduction) - occ_check_tv lhs_tv occ_tv + check_given :: TcType -> TcM (PuResult (TcTyVar,TcType) Reduction) + check_given = case lhs of + TyFamLHS {} -> checkTyEqRhs ghci_tv refl_tv check_given_fam_app refl_co + TyVarLHS tv -> checkTyEqRhs ghci_tv (check_tv tv) check_given_fam_app (check_co tv) + + check_wanted :: TcType -> TcM (PuResult Ct Reduction) + check_wanted = case lhs of + TyFamLHS {} -> checkTyEqRhs ghci_tv refl_tv check_wanted_fam_app refl_co + TyVarLHS tv -> checkTyEqRhs ghci_tv (check_tv tv) check_wanted_fam_app (check_co tv) + + check_wanted_fam_app _ tc tys -- Just recurse; if there is an + -- occurs check etc, just fail + = do { tys_res <- mapCheck check_wanted tys + ; return (mkTyConAppRedn Nominal tc <$> tys_res) } + + check_given_fam_app fam_app tc tys + = -- Try just checking the arguments + do { tys_res <- mapCheck check_given tys + ; case tys_res of { + PuOK redns cts -> return (PuOK (mkTyConAppRedn Nominal tc redns) cts) ; + PuFail {} -> + + do { new_tv <- TcM.newCycleBreakerTyVar (typeKind fam_app) + ; return (PuOK (mkReflRedn Nominal (mkTyVarTy new_tv)) + (unitBag (new_tv, fam_app))) } }} + -- Why reflexive? See Detail (4) of the Note + + refl_tv tv = okCheckRefl (mkTyVarTy tv) + + check_tv :: TcTyVar -> TcTyVar -> TcM (PuResult a Reduction) + check_tv lhs_tv occ_tv | occursCheckTv lhs_tv occ_tv = failCheckWith (occursProblem eq_rel) | otherwise = okCheckRefl (mkTyVarTy occ_tv) - occ_check_co lhs_tv co - | lhs_tv `elemVarSet` tyCoVarsOfCo co = failCheckWith insolubleOccursProblem - | otherwise = return (pure co) + refl_co co = return (pure co) + + check_co :: TcTyVar -> TcCoercion -> TcM (PuResult a Coercion) + check_co lhs_tv co = simpleCheckCo lhs_tv False co mk_new_given :: (TcTyVar, TcType) -> TcS CtEvidence mk_new_given (new_tv, fam_app) @@ -2155,29 +2317,49 @@ checkTypeEq ev eq_rel lhs rhs -- See Detail (7) of the Note cb_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin + ------------------------- -flattenGivenFamApp :: TcType -> TcM (PuResult (TcTyVar, TcType) Reduction) -flattenGivenFamApp fam_app - = do { new_tv <- TcM.newCycleBreakerTyVar (typeKind fam_app) - ; return (PuOK (mkReflRedn Nominal (mkTyVarTy new_tv)) - (unitBag (new_tv, fam_app))) } - -- Why reflexive? See Detail (4) of the Note - -flattenWantedFamApp :: CtEvidence -> TcLevel - -> TcType -> TcM (PuResult Ct Reduction) -flattenWantedFamApp ev tv_lvl fam_app_ty - = do { new_tv_ty <- TcM.newMetaTyVarTyAtLevel tv_lvl (typeKind fam_app_ty) - ; let pty = mkPrimEqPredRole Nominal fam_app_ty new_tv_ty - ; hole <- TcM.newCoercionHole pty - ; let ev = CtWanted { ctev_pred = pty - , ctev_dest = HoleDest hole - , ctev_loc = cb_loc - , ctev_rewriters = ctEvRewriters ev } - ; return (PuOK (mkReduction (HoleCo hole) new_tv_ty) - (singleCt (mkNonCanonical ev))) } +checkFreeVars :: TcTyVar -> TcLevel -> TyCoVarSet -> TcM CheckTyEqResult +-- Check this set of TyCoVars for +-- (a) occurs check +-- (b) promote if necessary, or report skolem escape +checkFreeVars lhs_tv dest_lvl vs + = do { oks <- mapM do_one (nonDetEltsUniqSet vs) + ; return (mconcat oks) } where - -- See Detail (7) of the Note - cb_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin + do_one :: TyCoVar -> TcM CheckTyEqResult + do_one v | isCoVar v = return cteOK + | lhs_tv == v = return insolubleOccursProblem + | no_promotion = return cteOK + | not (isMetaTyVar v) = return (cteProblem cteSkolemEscape) + | otherwise = promote_one v + where + no_promotion = not (tcTyVarLevel v `strictlyDeeperThan` dest_lvl) + + -- isCoVar case: coercion variables are not an escape risk + -- If an implication binds a coercion variable, it'll have equalities, + -- so the "intervening given equalities" test above will catch it + -- Coercion holes get filled with coercions, so again no problem. + + promote_one tv = do { _ <- promote_meta_tyvar TauTv dest_lvl tv + ; return cteOK } + +promote_meta_tyvar :: MetaInfo -> TcLevel -> TcTyVar -> TcM TcType +promote_meta_tyvar info dest_lvl occ_tv + = do { -- Check whether occ_tv is already unified. The rhs-type + -- started zonked, but we may have promoted one of its type + -- variables, and we then encounter it for the second time. + -- But if so, it'll definitely be another already-checked TyVar + mb_filled <- TcM.isFilledMetaTyVar_maybe occ_tv + ; case mb_filled of { + Just ty -> return ty ; + Nothing -> + + -- OK, not done already, so clone/promote it + do { new_tv <- TcM.cloneMetaTyVarWithInfo info dest_lvl occ_tv + ; TcM.writeMetaTyVar occ_tv (mkTyVarTy new_tv) + ; TcM.traceTc "promoteTyVar" (ppr occ_tv <+> text "-->" <+> ppr new_tv) + ; return (mkTyVarTy new_tv) } } } ------------------------- -- | Fill in CycleBreakerTvs with the variables they stand for. @@ -2188,12 +2370,3 @@ restoreTyVarCycles is {-# SPECIALISE forAllCycleBreakerBindings_ :: CycleBreakerVarStack -> (TcTyVar -> TcType -> TcM ()) -> TcM () #-} --- Unwrap a type synonym only when either: --- The type synonym is forgetful, or --- the type synonym mentions a type family in its expansion --- See Note [Rewriting synonyms] in GHC.Tc.Solver.Rewrite. -rewriterView :: TcType -> Maybe TcType -rewriterView ty@(Rep.TyConApp tc _) - | isForgetfulSynTyCon tc || (isTypeSynonymTyCon tc && not (isFamFreeTyCon tc)) - = coreView ty -rewriterView _other = Nothing ===================================== compiler/GHC/Tc/Solver/Rewrite.hs ===================================== @@ -665,6 +665,16 @@ rewrite_vector ki roles tys {-# INLINE rewrite_vector #-} +-- Unwrap a type synonym only when either: +-- The type synonym is forgetful, or +-- the type synonym mentions a type family in its expansion +-- See Note [Rewriting synonyms] +rewriterView :: TcType -> Maybe TcType +rewriterView ty@(TyConApp tc _) + | isForgetfulSynTyCon tc || (isTypeSynonymTyCon tc && not (isFamFreeTyCon tc)) + = coreView ty +rewriterView _other = Nothing + {- Note [Do not rewrite newtypes] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We flirted with unwrapping newtypes in the rewriter -- see GHC.Tc.Solver.Canonical ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -481,7 +481,7 @@ isInsolubleReason AbstractTyConReason = True -- ------------------------------------------------------------------------------ --- | A set of problems in checking the validity of a type equality. +-- | A /set/ of problems in checking the validity of a type equality. -- See 'checkTypeEq'. newtype CheckTyEqResult = CTER Word8 @@ -494,7 +494,7 @@ cterHasNoProblem :: CheckTyEqResult -> Bool cterHasNoProblem (CTER 0) = True cterHasNoProblem _ = False --- | An individual problem that might be logged in a 'CheckTyEqResult' +-- | An /individual/ problem that might be logged in a 'CheckTyEqResult' newtype CheckTyEqProblem = CTEP Word8 cteImpredicative, cteTypeFamily, cteInsolubleOccurs, ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -986,7 +986,7 @@ writeMetaTyVarRef tyvar ref ty ; let zonked_ty_kind = typeKind zonked_ty zonked_ty_lvl = tcTypeLevel zonked_ty level_check_ok = not (zonked_ty_lvl `strictlyDeeperThan` tv_lvl) - level_check_msg = ppr zonked_ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty + level_check_msg = ppr zonked_ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty $$ ppr zonked_ty kind_check_ok = zonked_ty_kind `eqType` zonked_tv_kind -- Note [Extra-constraint holes in partial type signatures] in GHC.Tc.Gen.HsType ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -38,7 +38,7 @@ module GHC.Tc.Utils.TcType ( -- TcLevel TcLevel(..), topTcLevel, pushTcLevel, isTopTcLevel, strictlyDeeperThan, deeperThanOrSame, sameDepthAs, - tcTypeLevel, tcTyVarLevel, maxTcLevel, + tcTypeLevel, tcTyVarLevel, maxTcLevel, minTcLevel, -------------------------------- -- MetaDetails @@ -47,7 +47,7 @@ module GHC.Tc.Utils.TcType ( isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isMetaTyVarTy, isTyVarTy, tcIsTcTyVar, isTyVarTyVar, isOverlappableTyVar, isTyConableTyVar, ConcreteTvOrigin(..), isConcreteTyVar_maybe, isConcreteTyVar, - isConcreteTyVarTy, isConcreteTyVarTy_maybe, + isConcreteTyVarTy, isConcreteTyVarTy_maybe, isConcreteInfo, isAmbiguousTyVar, isCycleBreakerTyVar, metaTyVarRef, metaTyVarInfo, isFlexi, isIndirect, isRuntimeUnkSkol, metaTyVarTcLevel, setMetaTyVarTcLevel, metaTyVarTcLevel_maybe, @@ -800,6 +800,9 @@ touchable; but then 'b' has escaped its scope into the outer implication. maxTcLevel :: TcLevel -> TcLevel -> TcLevel maxTcLevel (TcLevel a) (TcLevel b) = TcLevel (a `max` b) +minTcLevel :: TcLevel -> TcLevel -> TcLevel +minTcLevel (TcLevel a) (TcLevel b) = TcLevel (a `min` b) + topTcLevel :: TcLevel -- See Note [TcLevel assignment] topTcLevel = TcLevel 0 -- 0 = outermost level @@ -1203,6 +1206,10 @@ isConcreteTyVar_maybe tv | otherwise = Nothing +isConcreteInfo :: MetaInfo -> Bool +isConcreteInfo (ConcreteTv {}) = True +isConcreteInfo _ = False + -- | Is this type variable a concrete type variable, i.e. -- it is a metavariable with 'ConcreteTv' 'MetaInfo'? isConcreteTyVar :: TcTyVar -> Bool ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -33,9 +33,9 @@ module GHC.Tc.Utils.Unify ( matchExpectedFunKind, matchActualFunTySigma, matchActualFunTysRho, - checkTyEqRhs, checkTvUnif, checkCoUnif, occursCheckTv, - PuResult(..), failCheckWith, okCheckRefl - + checkTyEqRhs, simpleCheckCo, + PuResult(..), failCheckWith, okCheckRefl, mapCheck, + AreUnifying(..), areUnifying, occursCheckTv ) where import GHC.Prelude @@ -2551,140 +2551,6 @@ kind had instead been then this kind equality would rightly complain about unifying kappa with (forall k. k->*) --} - -{- -{-# NOINLINE checkTyVarEq #-} -- checkTyVarEq becomes big after the `inline` fires -checkTyVarEq :: TcTyVar -> TcType -> CheckTyEqResult -checkTyVarEq tv ty - = inline checkTypeEq (TyVarLHS tv) ty - -- inline checkTypeEq so that the `case`s over the CanEqLHS get blasted away - -{-# NOINLINE checkTyFamEq #-} -- checkTyFamEq becomes big after the `inline` fires -checkTyFamEq :: TyCon -- type function - -> [TcType] -- args, exactly saturated - -> TcType -- RHS - -> CheckTyEqResult -- always drops cteTypeFamily -checkTyFamEq fun_tc fun_args ty - = inline checkTypeEq (TyFamLHS fun_tc fun_args) ty - `cterRemoveProblem` cteTypeFamily - -- inline checkTypeEq so that the `case`s over the CanEqLHS get blasted away - -checkTypeEq :: CanEqLHS -> TcType -> CheckTyEqResult --- If cteHasNoProblem (checkTypeEq dflags lhs rhs), then lhs ~ rhs --- is a canonical CEqCan. --- --- In particular, this looks for: --- (a) a forall type (forall a. blah) --- (b) a predicate type (c => ty) --- (c) a type family; see Note [Prevent unification with type families] --- (d) an occurrence of the LHS (occurs check) --- --- Note that an occurs-check does not mean "definite error". For example --- type family F a --- type instance F Int = Int --- consider --- b0 ~ F b0 --- This is perfectly reasonable, if we later get b0 ~ Int. But we --- certainly can't unify b0 := F b0 --- --- For (a), (b), and (c) we check only the top level of the type, NOT --- inside the kinds of variables it mentions, and for (d) see --- Note [CEqCan occurs check] in GHC.Tc.Types.Constraint. --- --- checkTypeEq is called from --- * checkTyFamEq, checkTyVarEq (which inline it to specialise away the --- case-analysis on 'lhs') --- * checkEqCanLHSFinish, which does not know the form of 'lhs' -checkTypeEq lhs ty - = go ty - where - impredicative = cteProblem cteImpredicative - type_family = cteProblem cteTypeFamily - insoluble_occurs = cteProblem cteInsolubleOccurs - soluble_occurs = cteProblem cteSolubleOccurs - - -- The GHCi runtime debugger does its type-matching with - -- unification variables that can unify with a polytype - -- or a TyCon that would usually be disallowed by bad_tc - -- See Note [RuntimeUnkTv] in GHC.Runtime.Heap.Inspect - ghci_tv - | TyVarLHS tv <- lhs - , MetaTv { mtv_info = RuntimeUnkTv } <- tcTyVarDetails tv - = True - - | otherwise - = False - - go :: TcType -> CheckTyEqResult - go (TyVarTy tv') = go_tv tv' - go (TyConApp tc tys) = go_tc tc tys - go (LitTy {}) = cteOK - go (FunTy {ft_af = af, ft_mult = w, ft_arg = a, ft_res = r}) - = go w S.<> go a S.<> go r S.<> - if not ghci_tv && isInvisibleFunArg af - then impredicative - else cteOK - go (AppTy fun arg) = go fun S.<> go arg - go (CastTy ty co) = go ty S.<> go_co co - go (CoercionTy co) = go_co co - go (ForAllTy (Bndr tv' _) ty) = (case lhs of - TyVarLHS tv | tv == tv' -> go_occ (tyVarKind tv') S.<> cterClearOccursCheck (go ty) - | otherwise -> go_occ (tyVarKind tv') S.<> go ty - _ -> go ty) - S.<> - if ghci_tv then cteOK else impredicative - - go_tv :: TcTyVar -> CheckTyEqResult - -- this slightly peculiar way of defining this means - -- we don't have to evaluate this `case` at every variable - -- occurrence - go_tv = case lhs of - TyVarLHS tv -> \ tv' -> go_occ (tyVarKind tv') S.<> - if tv == tv' then insoluble_occurs else cteOK - TyFamLHS {} -> \ _tv' -> cteOK - -- See Note [Occurrence checking: look inside kinds] in GHC.Core.Type - - -- For kinds, we only do an occurs check; we do not worry - -- about type families or foralls - -- See Note [Checking for foralls] - go_occ k = cterFromKind $ go k - - go_tc :: TyCon -> [TcType] -> CheckTyEqResult - -- this slightly peculiar way of defining this means - -- we don't have to evaluate this `case` at every tyconapp - go_tc = case lhs of - TyVarLHS {} -> \ tc tys -> check_tc tc S.<> go_tc_args tc tys - TyFamLHS fam_tc fam_args -> \ tc tys -> - if tcEqTyConApps fam_tc fam_args tc tys - then insoluble_occurs - else check_tc tc S.<> go_tc_args tc tys - - -- just look at arguments, not the tycon itself - go_tc_args :: TyCon -> [TcType] -> CheckTyEqResult - go_tc_args tc tys | isGenerativeTyCon tc Nominal = foldMap go tys - | otherwise - = let (tf_args, non_tf_args) = splitAt (tyConArity tc) tys in - cterSetOccursCheckSoluble (foldMap go tf_args) S.<> foldMap go non_tf_args - - -- no bother about impredicativity in coercions, as they're - -- inferred - go_co co | TyVarLHS tv <- lhs - , tv `elemVarSet` tyCoVarsOfCo co - = soluble_occurs - - -- Don't check coercions for type families; see commentary at top of function - | otherwise - = cteOK - - check_tc :: TyCon -> CheckTyEqResult - check_tc - | ghci_tv = \ _tc -> cteOK - | otherwise = \ tc -> (if isTauTyCon tc then cteOK else impredicative) S.<> - (if isFamFreeTyCon tc then cteOK else type_family) --} - -{- Note [prepareForUnification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ alpha[2] ~ ty @@ -2762,53 +2628,94 @@ instance Applicative (PuResult a) where PuOK {} <*> PuFail p2 = PuFail p2 PuOK f c1 <*> PuOK x c2 = PuOK (f x) (c1 `unionBags` c2) +instance (Outputable a, Outputable b) => Outputable (PuResult a b) where + ppr (PuFail prob) = text "PuFail" <+> (ppr prob) + ppr (PuOK x cts) = text "PuOK" <> braces + (vcat [ text "redn:" <+> ppr x + , text "cts:" <+> ppr cts ]) + okCheckRefl :: TcType -> TcM (PuResult a Reduction) okCheckRefl ty = return (PuOK (mkReflRedn Nominal ty) emptyBag) failCheckWith :: CheckTyEqResult -> TcM (PuResult a b) failCheckWith p = return (PuFail p) +mapCheck :: (x -> TcM (PuResult a Reduction)) + -> [x] + -> TcM (PuResult a Reductions) +mapCheck f xs + = do { (ress :: [PuResult a Reduction]) <- mapM f xs + ; return (unzipRedns <$> sequenceA ress) } + -- sequenceA :: [PuResult a Reduction] -> PuResult a [Reduction] + -- unzipRedns :: [Reduction] -> Reductions + +data AreUnifying + = UnifyingAt TcLevel -- We are trying to unify a meta-tyvar at level lvl + | NotUnifying -- Not attempting to unify + +areUnifying :: AreUnifying -> Bool +areUnifying (UnifyingAt {}) = True +areUnifying NotUnifying = False + +occursCheckTv :: TcTyVar -> TcTyVar -> Bool +occursCheckTv lhs_tv occ_tv + = lhs_tv == occ_tv + || lhs_tv `elemVarSet` tyCoVarsOfType (tyVarKind occ_tv) + uTypeCheckTouchableTyVarEq :: TcTyVar -> TcType -> TcM (PuResult () ()) -uTypeCheckTouchableTyVarEq tv rhs - | MetaTv { mtv_info = tv_info, mtv_tclvl = tv_lvl } <- tcTyVarDetails tv - = do { check_result <- checkTyEqRhs False dont_flatten - (checkTvUnif tv tv_info tv_lvl) - (checkCoUnif tv) +uTypeCheckTouchableTyVarEq lhs_tv rhs + | MetaTv { mtv_info = tv_info } <- tcTyVarDetails lhs_tv + = do { check_result <- checkTyEqRhs False + (simple_check_tv (isConcreteInfo tv_info)) + dont_flatten + (simpleCheckCo lhs_tv True) rhs - -- checkTvUnif will never do any promotion because tv_lvl is - -- the ambient level. But we still need the concreteness changes ; case check_result of PuFail reason -> return (PuFail reason) - PuOK redn _ -> assertPpr (isReflCo (reductionCoercion redn)) - (ppr tv $$ ppr rhs $$ ppr redn) $ - return (PuOK () emptyBag) } + PuOK redn _ -> assertPpr (isReflCo (reductionCoercion redn)) + (ppr lhs_tv $$ ppr rhs $$ ppr redn) $ + return (PuOK () emptyBag) } -- Only called on meta-tyvars - | otherwise = pprPanic "uTypeCHeckTouchableTyVarEq" (ppr tv) + | otherwise = pprPanic "uTypeCHeckTouchableTyVarEq" (ppr lhs_tv) where - dont_flatten :: TcType -> TcM (PuResult () Reduction) - dont_flatten _ = failCheckWith (cteProblem cteTypeFamily) + dont_flatten :: TcType -> TyCon -> [TcType] -> TcM (PuResult () Reduction) + dont_flatten _ _ _ = failCheckWith (cteProblem cteTypeFamily) -- See Note [Prevent unification with type families] + simple_check_tv lhs_tv_is_concrete occ_tv + | occursCheckTv lhs_tv occ_tv + = failCheckWith insolubleOccursProblem + | lhs_tv_is_concrete, not (isConcreteTyVar occ_tv) + = failCheckWith (cteProblem cteConcrete) + | otherwise + = okCheckRefl (mkTyVarTy occ_tv) + +simpleCheckCo :: TcTyVar -> Bool -> TcCoercion -> TcM (PuResult a Coercion) +-- No bother about impredicativity in coercions, as they're inferred +-- Don't check coercions for type families; see commentary at top of function +simpleCheckCo lhs_tv unifying co + | lhs_tv `elemVarSet` tyCoVarsOfCo co = failCheckWith insolubleOccursProblem + | unifying + , hasCoercionHoleCo co = failCheckWith (cteProblem cteCoercionHole) + | otherwise = return (PuOK co emptyBag) + -- hasCoercionHoleCo: + -- See (COERCION-HOLE) in Note [Unification preconditions] + -- + -- ToDo: could combine these two folds + -- (free vars and coercion holes) into one + +----------------------------- checkTyEqRhs :: forall a. Bool -- RuntimeUnk tyvar on the LHS; accept foralls - -> (TcType -> TcM (PuResult a Reduction)) -> (TcTyVar -> TcM (PuResult a Reduction)) + -> (TcType -> TyCon -> [TcType] -> TcM (PuResult a Reduction)) -> (TcCoercion -> TcM (PuResult a TcCoercion)) -> TcType -> TcM (PuResult a Reduction) -checkTyEqRhs ghci_tv flatten_fam_app check_tv check_co rhs - = case coreFullView rhs of - -- Special case for lhs ~ F tys - -- We don't want to flatten that (F tys) - TyConApp tc tys | isTypeFamilyTyCon tc - -> do { tys_res <- go_tys tys - ; return (mkTyConAppRedn Nominal tc <$> tys_res) } - - -- Normal case - _other -> go rhs - +checkTyEqRhs ghci_tv check_tv flatten_fam_app check_co rhs + = go rhs where go :: TcType -> TcM (PuResult a Reduction) go ty@(LitTy {}) = okCheckRefl ty @@ -2840,23 +2747,17 @@ checkTyEqRhs ghci_tv flatten_fam_app check_tv check_co rhs | ghci_tv = okCheckRefl ty | otherwise = failCheckWith impredicativeProblem -- Not allowed (TyEq:F) - go_tys :: [TcType] -> TcM (PuResult a Reductions) - go_tys tys = do { (ress :: [PuResult a Reduction]) <- mapM go tys - ; return (unzipRedns <$> sequenceA ress) } - -- sequenceA :: [PuResult a] -> PuResult [a] - -- unzipRedns :: [Reduction] -> Reductions - go_tc :: TcType -> TyCon -> [TcType] -> TcM (PuResult a Reduction) go_tc ty tc tys | isTypeFamilyTyCon tc - = flatten_fam_app ty + = flatten_fam_app ty tc tys | not (isFamFreeTyCon tc) -- e.g. S a where type S a = F [a] , Just ty' <- coreView ty -- Only synonyms and type families reply = go ty' -- False to isFamFreeTyCon | otherwise - = do { tys_res <- go_tys tys + = do { tys_res <- mapCheck go tys ; if | PuFail {} <- tys_res, Just ty' <- coreView ty -> go ty' -- Expand synonyms on failure | not (isTauTyCon tc || ghci_tv) @@ -2864,83 +2765,6 @@ checkTyEqRhs ghci_tv flatten_fam_app check_tv check_co rhs | otherwise -> return (mkTyConAppRedn Nominal tc <$> tys_res) } -------------------------- -checkCoUnif :: TcTyVar -> TcCoercion -> TcM (PuResult a TcCoercion) --- No bother about impredicativity in coercions, as they're inferred --- Don't check coercions for type families; see commentary at top of function -checkCoUnif lhs_tv co - | lhs_tv `elemVarSet` tyCoVarsOfCo co = failCheckWith insolubleOccursProblem - | hasCoercionHoleCo co = failCheckWith (cteProblem cteCoercionHole) - | otherwise = return (PuOK co emptyBag) - -- ToDo: could combine these two folds - -- (free vars and coercion holes) into one - -------------------------- -checkTvUnif :: TcTyVar -> MetaInfo -> TcLevel -- The LHS tv, a touchable meta tvar - -> TcTyVar -- An occurrence of a tyvar in the RHS - -> TcM (PuResult a Reduction) -checkTvUnif lhs_tv lhs_tv_info lhs_tv_lvl occ_tv - | occursCheckTv lhs_tv occ_tv - = failCheckWith insolubleOccursProblem - -- Unification is always Nominal, so no faffing - -- with Note [Occurs check and representational equality] - - | MetaTv { mtv_info = info_occ, mtv_tclvl = lvl_occ } <- occ_details - = -- Check for unified. The type started zonked, but we may have - -- promoted one of its type variables, and we then encounter - -- it for the second time. But if so, it'll definitely be another TyVar - do { mb_filled <- isFilledMetaTyVar_maybe occ_tv - ; case mb_filled of - Just ty | Just occ_tv2 <- getTyVar_maybe ty - -> checkTvUnif lhs_tv lhs_tv_info lhs_tv_lvl occ_tv2 - | otherwise -> pprPanic "checkTouchableTyVarEq" (ppr occ_tv $$ ppr ty) - Nothing -> check_tv2 occ_tv info_occ lvl_occ } - - | SkolemTv _ lvl_occ _ <- occ_details - , need_to_promote lvl_occ -- Skolem tyvar that needs promotion; skolem escape - = failCheckWith (cteProblem cteSkolemEscape) - - | otherwise - = okCheckRefl (mkTyVarTy occ_tv) - where - occ_details = tcTyVarDetails occ_tv - - check_tv2 occ_tv info_occ lvl_occ - | not (need_to_promote lvl_occ) - , not (need_to_make_concrete info_occ) - = okCheckRefl (mkTyVarTy occ_tv) -- No-op - - | tv_is_concrete - , cant_make_concrete info_occ - = failCheckWith (cteProblem cteConcrete) -- E.g. alpha[conc] := Maybe beta[tv] - - | otherwise - = do { let new_info | tv_is_concrete = lhs_tv_info - | otherwise = info_occ - ; new_tv <- cloneMetaTyVarWithInfo new_info lhs_tv_lvl occ_tv - ; writeMetaTyVar occ_tv (mkTyVarTy new_tv) - ; traceTc "promoteTyVar" (ppr occ_tv <+> text "-->" <+> ppr new_tv) - ; okCheckRefl (mkTyVarTy new_tv) } - - need_to_promote lvl_occ = lvl_occ `strictlyDeeperThan` lhs_tv_lvl - need_to_make_concrete info_occ = is_concrete lhs_tv_info && not (is_concrete info_occ) - - cant_make_concrete (ConcreteTv {}) = False - cant_make_concrete TauTv = False - cant_make_concrete _ = True - -- Don't attempt to make other type variables concrete - -- (e.g. SkolemTv, TyVarTv, CycleBreakerTv, RuntimeUnkTv). - - tv_is_concrete = is_concrete lhs_tv_info - - is_concrete (ConcreteTv {}) = True - is_concrete _ = False - -occursCheckTv :: TcTyVar -> TcTyVar -> Bool -occursCheckTv lhs_tv occ_tv - = lhs_tv == occ_tv - || lhs_tv `elemVarSet` tyCoVarsOfType (tyVarKind occ_tv) - ------------------------- touchabilityTest :: TcLevel -> TcTyVar -> TcType -> Bool -- This is the key test for untouchability: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26ce990bef18ba7a9c8af12628085d1fb890e856 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26ce990bef18ba7a9c8af12628085d1fb890e856 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 03:53:12 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Sun, 12 Mar 2023 23:53:12 -0400 Subject: [Git][ghc/ghc][wip/js-forceBool] JS: fix implementation of forceBool to use JS backend syntax Message-ID: <640e9e2885cb6_36ed6c4295b5b83853a4@gitlab.mail> Josh Meredith pushed to branch wip/js-forceBool at Glasgow Haskell Compiler / GHC Commits: 18c254ad by Josh Meredith at 2023-03-13T03:52:55+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 4 changed files: - compiler/GHC/HsToCore/Foreign/JavaScript.hs - + testsuite/tests/javascript/T23101.hs - + testsuite/tests/javascript/T23101.stdout - + testsuite/tests/javascript/all.T Changes: ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -639,7 +639,7 @@ jsResultWrapper result_ty | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey = do -- result_id <- newSysLocalDs boolTy ccall_uniq <- newUnique - let forceBool e = mkJsCall ccall_uniq (fsLit "$r = !(!$1)") [e] boolTy + let forceBool e = mkJsCall ccall_uniq (fsLit "((x) => { return !(!x); })") [e] boolTy return (Just intPrimTy, \e -> forceBool e) ===================================== testsuite/tests/javascript/T23101.hs ===================================== @@ -0,0 +1,22 @@ + +foreign import javascript "(($1) => { return $1; })" + bool_id :: Bool -> Bool + +foreign import javascript "(($1) => { return !$1; })" + bool_not :: Bool -> Bool + +foreign import javascript "(($1) => { console.log($1); })" + bool_log :: Bool -> IO () + +main :: IO () +main = do + bool_log True + bool_log False + bool_log (bool_id True) + bool_log (bool_id False) + bool_log (bool_not True) + bool_log (bool_not False) + print (bool_id True) + print (bool_id False) + print (bool_not True) + print (bool_not False) ===================================== testsuite/tests/javascript/T23101.stdout ===================================== @@ -0,0 +1,10 @@ +true +false +true +false +false +true +True +False +False +True ===================================== testsuite/tests/javascript/all.T ===================================== @@ -0,0 +1,4 @@ +# These are JavaScript-specific tests +setTestOpts(when(not(js_arch()),skip)) + +test('T23101', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18c254ad2a5afb09c478902b878e37eb26b3f2b1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18c254ad2a5afb09c478902b878e37eb26b3f2b1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 03:56:06 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Sun, 12 Mar 2023 23:56:06 -0400 Subject: [Git][ghc/ghc][wip/js-forceBool] 5 commits: DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) Message-ID: <640e9ed6935c2_36ed6c4295b5b8385750@gitlab.mail> Josh Meredith pushed to branch wip/js-forceBool at Glasgow Haskell Compiler / GHC Commits: ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 10 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/StgToJS/Linker/Utils.hs - rts/js/rts.js - + testsuite/tests/javascript/T23101.hs - + testsuite/tests/javascript/T23101.stdout - + testsuite/tests/javascript/all.T - + testsuite/tests/stranal/should_compile/T22997.hs - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1916,10 +1916,11 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- Check for an OPAQUE function: see Note [OPAQUE pragma] -- In that case, trim off all boxity info from argument demands + -- and demand info on lambda binders -- See Note [The OPAQUE pragma and avoiding the reboxing of arguments] | isOpaquePragma (idInlinePragma fn) , let trimmed_rhs_dmds = map trimBoxity rhs_dmds - = (trimmed_rhs_dmds, add_demands trimmed_rhs_dmds rhs) + = (trimmed_rhs_dmds, set_lam_dmds trimmed_rhs_dmds rhs) -- Check that we have enough visible binders to match the -- threshold arity; if not, we won't do worker/wrapper @@ -1939,8 +1940,8 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- vcat [text "function:" <+> ppr fn -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ - (arg_dmds', add_demands arg_dmds' rhs) - -- add_demands: we must attach the final boxities to the lambda-binders + (arg_dmds', set_lam_dmds arg_dmds' rhs) + -- set_lam_dmds: we must attach the final boxities to the lambda-binders -- of the function, both because that's kosher, and because CPR analysis -- uses the info on the binders directly. where @@ -2032,17 +2033,18 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs | positiveTopBudget bg_inner' = (bg_inner', dmd') | otherwise = (bg_inner, trimBoxity dmd) - add_demands :: [Demand] -> CoreExpr -> CoreExpr + set_lam_dmds :: [Demand] -> CoreExpr -> CoreExpr -- Attach the demands to the outer lambdas of this expression - add_demands [] e = e - add_demands (dmd:dmds) (Lam v e) - | isTyVar v = Lam v (add_demands (dmd:dmds) e) - | otherwise = Lam (v `setIdDemandInfo` dmd) (add_demands dmds e) - add_demands dmds (Cast e co) = Cast (add_demands dmds e) co + set_lam_dmds (dmd:dmds) (Lam v e) + | isTyVar v = Lam v (set_lam_dmds (dmd:dmds) e) + | otherwise = Lam (v `setIdDemandInfo` dmd) (set_lam_dmds dmds e) + set_lam_dmds dmds (Cast e co) = Cast (set_lam_dmds dmds e) co -- This case happens for an OPAQUE function, which may look like -- f = (\x y. blah) |> co -- We give it strictness but no boxity (#22502) - add_demands dmds e = pprPanic "add_demands" (ppr dmds $$ ppr e) + set_lam_dmds _ e = e + -- In the OPAQUE case, the list of demands at this point might be + -- non-empty, e.g., when looking at a PAP. Hence don't panic (#22997). finaliseLetBoxity :: AnalEnv ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1859,11 +1859,12 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpandRhs env bind_cxt bndr rhs - | do_eta_expand -- If the current manifest arity isn't enough - -- (never true for join points) - , seEtaExpand env -- and eta-expansion is on - , wantEtaExpansion rhs - = -- Do eta-expansion. + | seEtaExpand env -- If Eta-expansion is on + , wantEtaExpansion rhs -- and we'd like to eta-expand e + , do_eta_expand -- and e's manifest arity is lower than + -- what it could be + -- (never true for join points) + = -- Do eta-expansion. assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ -- assert: this never happens for join points; see GHC.Core.Opt.Arity -- Note [Do not eta-expand join points] ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -639,7 +639,7 @@ jsResultWrapper result_ty | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey = do -- result_id <- newSysLocalDs boolTy ccall_uniq <- newUnique - let forceBool e = mkJsCall ccall_uniq (fsLit "$r = !(!$1)") [e] boolTy + let forceBool e = mkJsCall ccall_uniq (fsLit "((x) => { return !(!x); })") [e] boolTy return (Just intPrimTy, \e -> forceBool e) ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -115,8 +115,8 @@ genCommonCppDefs profiling = mconcat -- GHCJS.Prim.JSVal , if profiling - then "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)\n" - else "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x))\n" + then "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM))\n" + else "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x)))\n" , "#define JSVAL_VAL(x) ((x).d1)\n" -- GHCJS.Prim.JSException ===================================== rts/js/rts.js ===================================== @@ -365,14 +365,7 @@ function h$printReg(r) { } else if(r.f.t === h$ct_blackhole && r.x) { return ("blackhole: -> " + h$printReg({ f: r.x.x1, d: r.d1.x2 }) + ")"); } else { - var iv = ""; - if(r.f.n === "integer-gmp:GHC.Integer.Type.Jp#" || - r.f.n === "integer-gmp:GHC.Integer.Type.Jn#") { - iv = ' [' + r.d1.join(',') + '](' + h$ghcjsbn_showBase(r.d1, 10) + ')' - } else if(r.f.n === "integer-gmp:GHC.Integer.Type.S#") { - iv = ' (S: ' + r.d1 + ')'; - } - return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")" + iv); + return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")"); } } else if(typeof r === 'object') { var res = h$collectProps(r); @@ -536,14 +529,7 @@ function h$dumpStackTop(stack, start, sp) { if(s.f.t === h$ct_blackhole && s.d1 && s.d1.x1 && s.d1.x1.n) { h$log("stack[" + i + "] = blackhole -> " + s.d1.x1.n); } else { - var iv = ""; - if(s.f.n === "integer-gmp:GHC.Integer.Type.Jp#" || - s.f.n === "integer-gmp:GHC.Integer.Type.Jn#") { - iv = ' [' + s.d1.join(',') + '](' + h$ghcjsbn_showBase(s.d1, 10) + ')' - } else if(s.f.n === "integer-gmp:GHC.Integer.Type.S#") { - iv = ' (S: ' + s.d1 + ')'; - } - h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")" + iv); + h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")"); } } } else if(h$isInstanceOf(s,h$MVar)) { ===================================== testsuite/tests/javascript/T23101.hs ===================================== @@ -0,0 +1,22 @@ + +foreign import javascript "(($1) => { return $1; })" + bool_id :: Bool -> Bool + +foreign import javascript "(($1) => { return !$1; })" + bool_not :: Bool -> Bool + +foreign import javascript "(($1) => { console.log($1); })" + bool_log :: Bool -> IO () + +main :: IO () +main = do + bool_log True + bool_log False + bool_log (bool_id True) + bool_log (bool_id False) + bool_log (bool_not True) + bool_log (bool_not False) + print (bool_id True) + print (bool_id False) + print (bool_not True) + print (bool_not False) ===================================== testsuite/tests/javascript/T23101.stdout ===================================== @@ -0,0 +1,10 @@ +true +false +true +false +false +true +True +False +False +True ===================================== testsuite/tests/javascript/all.T ===================================== @@ -0,0 +1,4 @@ +# These are JavaScript-specific tests +setTestOpts(when(not(js_arch()),skip)) + +test('T23101', normal, compile_and_run, ['']) ===================================== testsuite/tests/stranal/should_compile/T22997.hs ===================================== @@ -0,0 +1,9 @@ +module T22997 where + +{-# OPAQUE trivial #-} +trivial :: Int -> Int +trivial = succ + +{-# OPAQUE pap #-} +pap :: Integer -> Integer +pap = (42 +) ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -88,3 +88,5 @@ test('EtaExpansion', normal, compile, ['']) test('T22039', normal, compile, ['']) # T22388: Should see $winteresting but not $wboring test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) +# T22997: Just a panic that should not happen +test('T22997', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/18c254ad2a5afb09c478902b878e37eb26b3f2b1...047e9d4f10e4124899887449dc52b9e72a7d3ea6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/18c254ad2a5afb09c478902b878e37eb26b3f2b1...047e9d4f10e4124899887449dc52b9e72a7d3ea6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 06:46:17 2023 From: gitlab at gitlab.haskell.org (Moritz Angermann (@angerman)) Date: Mon, 13 Mar 2023 02:46:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/fix-configure Message-ID: <640ec6b958ce3_36ed6c452f4dc0393117@gitlab.mail> Moritz Angermann pushed new branch wip/angerman/fix-configure at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/angerman/fix-configure You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 09:00:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 13 Mar 2023 05:00:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: JS: Fix implementation of MK_JSVAL Message-ID: <640ee63e9b9d3_36ed6c476878f04183d7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - d55dacfe by Sebastian Graf at 2023-03-13T05:00:42-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 6 changed files: - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/StgToJS/Linker/Utils.hs - + testsuite/tests/javascript/T23101.hs - + testsuite/tests/javascript/T23101.stdout - + testsuite/tests/javascript/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -553,7 +553,7 @@ countArgs _ = 0 countValArgs :: SimplCont -> Int -- Count value arguments only -countValArgs (ApplyToTy { sc_cont = cont }) = 1 + countValArgs cont +countValArgs (ApplyToTy { sc_cont = cont }) = countValArgs cont countValArgs (ApplyToVal { sc_cont = cont }) = 1 + countValArgs cont countValArgs (CastIt _ cont) = countValArgs cont countValArgs _ = 0 @@ -1859,11 +1859,12 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpandRhs env bind_cxt bndr rhs - | do_eta_expand -- If the current manifest arity isn't enough - -- (never true for join points) - , seEtaExpand env -- and eta-expansion is on - , wantEtaExpansion rhs - = -- Do eta-expansion. + | seEtaExpand env -- If Eta-expansion is on + , wantEtaExpansion rhs -- and we'd like to eta-expand e + , do_eta_expand -- and e's manifest arity is lower than + -- what it could be + -- (never true for join points) + = -- Do eta-expansion. assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ -- assert: this never happens for join points; see GHC.Core.Opt.Arity -- Note [Do not eta-expand join points] ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -639,7 +639,7 @@ jsResultWrapper result_ty | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey = do -- result_id <- newSysLocalDs boolTy ccall_uniq <- newUnique - let forceBool e = mkJsCall ccall_uniq (fsLit "$r = !(!$1)") [e] boolTy + let forceBool e = mkJsCall ccall_uniq (fsLit "((x) => { return !(!x); })") [e] boolTy return (Just intPrimTy, \e -> forceBool e) ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -115,8 +115,8 @@ genCommonCppDefs profiling = mconcat -- GHCJS.Prim.JSVal , if profiling - then "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)\n" - else "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x))\n" + then "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM))\n" + else "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x)))\n" , "#define JSVAL_VAL(x) ((x).d1)\n" -- GHCJS.Prim.JSException ===================================== testsuite/tests/javascript/T23101.hs ===================================== @@ -0,0 +1,22 @@ + +foreign import javascript "(($1) => { return $1; })" + bool_id :: Bool -> Bool + +foreign import javascript "(($1) => { return !$1; })" + bool_not :: Bool -> Bool + +foreign import javascript "(($1) => { console.log($1); })" + bool_log :: Bool -> IO () + +main :: IO () +main = do + bool_log True + bool_log False + bool_log (bool_id True) + bool_log (bool_id False) + bool_log (bool_not True) + bool_log (bool_not False) + print (bool_id True) + print (bool_id False) + print (bool_not True) + print (bool_not False) ===================================== testsuite/tests/javascript/T23101.stdout ===================================== @@ -0,0 +1,10 @@ +true +false +true +false +false +true +True +False +False +True ===================================== testsuite/tests/javascript/all.T ===================================== @@ -0,0 +1,4 @@ +# These are JavaScript-specific tests +setTestOpts(when(not(js_arch()),skip)) + +test('T23101', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/527137295fdfa11a05680f90cc4770f68acc4030...d55dacfef2e8384761367faa5893fe38e24822ef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/527137295fdfa11a05680f90cc4770f68acc4030...d55dacfef2e8384761367faa5893fe38e24822ef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 09:29:11 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 13 Mar 2023 05:29:11 -0400 Subject: [Git][ghc/ghc][wip/js-exports] 79 commits: Enable response files for linker if supported Message-ID: <640eece7abfde_36ed6c48010f484275b@gitlab.mail> Josh Meredith pushed to branch wip/js-exports at Glasgow Haskell Compiler / GHC Commits: 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 1ee58c56 by Josh Meredith at 2023-03-13T04:02:23+00:00 Add GHCJS's Foreign.Callback module - - - - - 1a85adae by Josh Meredith at 2023-03-13T04:03:14+00:00 JS Prims: fix some implementations - - - - - e1cb5ce8 by Josh Meredith at 2023-03-13T09:28:50+00:00 JS FFI: add tests - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/TmpFs.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/expected-undocumented-flags.txt - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/88cd4bba5bd839025f00cdd2a0a574cd52dadb2e...e1cb5ce894367af5f77565c1c5acb1d64974911a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/88cd4bba5bd839025f00cdd2a0a574cd52dadb2e...e1cb5ce894367af5f77565c1c5acb1d64974911a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 10:14:59 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Mon, 13 Mar 2023 06:14:59 -0400 Subject: [Git][ghc/ghc][wip/T23083] 6 commits: DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) Message-ID: <640ef7a31e185_36ed6c489697c04305cc@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - badeaf4d by Sebastian Graf at 2023-03-13T11:14:36+01:00 Simplifier: Simplification of arguments in a single function The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`, which seems to be the main way to simplify args. Hence I consolidated the code path to call `simplArg`, too, renaming to `simplLazyArg`. - - - - - c4fbfb8c by Sebastian Graf at 2023-03-13T11:14:36+01:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. Fixes #23083. - - - - - 12 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/StgToJS/Linker/Utils.hs - rts/js/rts.js - + testsuite/tests/simplCore/should_compile/T23083.hs - + testsuite/tests/simplCore/should_compile/T23083.stderr - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/stranal/should_compile/T22997.hs - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1916,10 +1916,11 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- Check for an OPAQUE function: see Note [OPAQUE pragma] -- In that case, trim off all boxity info from argument demands + -- and demand info on lambda binders -- See Note [The OPAQUE pragma and avoiding the reboxing of arguments] | isOpaquePragma (idInlinePragma fn) , let trimmed_rhs_dmds = map trimBoxity rhs_dmds - = (trimmed_rhs_dmds, add_demands trimmed_rhs_dmds rhs) + = (trimmed_rhs_dmds, set_lam_dmds trimmed_rhs_dmds rhs) -- Check that we have enough visible binders to match the -- threshold arity; if not, we won't do worker/wrapper @@ -1939,8 +1940,8 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- vcat [text "function:" <+> ppr fn -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ - (arg_dmds', add_demands arg_dmds' rhs) - -- add_demands: we must attach the final boxities to the lambda-binders + (arg_dmds', set_lam_dmds arg_dmds' rhs) + -- set_lam_dmds: we must attach the final boxities to the lambda-binders -- of the function, both because that's kosher, and because CPR analysis -- uses the info on the binders directly. where @@ -2032,17 +2033,18 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs | positiveTopBudget bg_inner' = (bg_inner', dmd') | otherwise = (bg_inner, trimBoxity dmd) - add_demands :: [Demand] -> CoreExpr -> CoreExpr + set_lam_dmds :: [Demand] -> CoreExpr -> CoreExpr -- Attach the demands to the outer lambdas of this expression - add_demands [] e = e - add_demands (dmd:dmds) (Lam v e) - | isTyVar v = Lam v (add_demands (dmd:dmds) e) - | otherwise = Lam (v `setIdDemandInfo` dmd) (add_demands dmds e) - add_demands dmds (Cast e co) = Cast (add_demands dmds e) co + set_lam_dmds (dmd:dmds) (Lam v e) + | isTyVar v = Lam v (set_lam_dmds (dmd:dmds) e) + | otherwise = Lam (v `setIdDemandInfo` dmd) (set_lam_dmds dmds e) + set_lam_dmds dmds (Cast e co) = Cast (set_lam_dmds dmds e) co -- This case happens for an OPAQUE function, which may look like -- f = (\x y. blah) |> co -- We give it strictness but no boxity (#22502) - add_demands dmds e = pprPanic "add_demands" (ppr dmds $$ ppr e) + set_lam_dmds _ e = e + -- In the OPAQUE case, the list of demands at this point might be + -- non-empty, e.g., when looking at a PAP. Hence don't panic (#22997). finaliseLetBoxity :: AnalEnv ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -1517,7 +1517,7 @@ rebuild env expr cont ApplyToVal { sc_arg = arg, sc_env = se, sc_dup = dup_flag , sc_cont = cont, sc_hole_ty = fun_ty } -- See Note [Avoid redundant simplification] - -> do { (_, _, arg') <- simplArg env dup_flag fun_ty se arg + -> do { (_, _, arg') <- simplLazyArg env dup_flag fun_ty Nothing se arg ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv @@ -1633,7 +1633,6 @@ simplCast env body co0 cont0 , sc_hole_ty = coercionLKind co }) } -- NB! As the cast goes past, the -- type of the hole changes (#16312) - -- (f |> co) e ===> (f (e |> co1)) |> co2 -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 @@ -1652,7 +1651,7 @@ simplCast env body co0 cont0 -- See Note [Avoiding exponential behaviour] MCo co1 -> - do { (dup', arg_se', arg') <- simplArg env dup fun_ty arg_se arg + do { (dup', arg_se', arg') <- simplLazyArg env dup fun_ty Nothing arg_se arg -- When we build the ApplyTo we can't mix the OutCoercion -- 'co' with the InExpr 'arg', so we simplify -- to make it all consistent. It's a bit messy. @@ -1678,16 +1677,18 @@ simplCast env body co0 cont0 -- See Note [Representation polymorphism invariants] in GHC.Core -- test: typecheck/should_run/EtaExpandLevPoly -simplArg :: SimplEnv -> DupFlag - -> OutType -- Type of the function applied to this arg - -> StaticEnv -> CoreExpr -- Expression with its static envt - -> SimplM (DupFlag, StaticEnv, OutExpr) -simplArg env dup_flag fun_ty arg_env arg +simplLazyArg :: SimplEnv -> DupFlag + -> OutType -- Type of the function applied to this arg + -> Maybe ArgInfo + -> StaticEnv -> CoreExpr -- Expression with its static envt + -> SimplM (DupFlag, StaticEnv, OutExpr) +simplLazyArg env dup_flag fun_ty mb_arg_info arg_env arg | isSimplified dup_flag = return (dup_flag, arg_env, arg) | otherwise = do { let arg_env' = arg_env `setInScopeFromE` env - ; arg' <- simplExprC arg_env' arg (mkBoringStop (funArgTy fun_ty)) + ; let arg_ty = funArgTy fun_ty + ; arg' <- simplExprC arg_env' arg (mkLazyArgStop arg_ty mb_arg_info) ; return (Simplified, zapSubstEnv arg_env', arg') } -- Return a StaticEnv that includes the in-scope set from 'env', -- because arg' may well mention those variables (#20639) @@ -2281,12 +2282,8 @@ rebuildCall env fun_info -- There is no benefit (unlike in a let-binding), and we'd -- have to be very careful about bogus strictness through -- floating a demanded let. - = do { arg' <- simplExprC (arg_se `setInScopeFromE` env) arg - (mkLazyArgStop arg_ty fun_info) + = do { (_, _, arg') <- simplLazyArg env dup_flag fun_ty (Just fun_info) arg_se arg ; rebuildCall env (addValArgTo fun_info arg' fun_ty) cont } - where - arg_ty = funArgTy fun_ty - ---------- No further useful info, revert to generic rebuild ------------ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont @@ -3723,7 +3720,7 @@ mkDupableContWithDmds env dmds do { let (dmd:cont_dmds) = dmds -- Never fails ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 - ; (_, se', arg') <- simplArg env' dup hole_ty se arg + ; (_, se', arg') <- simplLazyArg env' dup hole_ty Nothing se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ; let all_floats = floats1 `addLetFloats` let_floats2 ; return ( all_floats ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -461,8 +461,9 @@ mkRhsStop :: OutType -> RecFlag -> Demand -> SimplCont -- See Note [RHS of lets] in GHC.Core.Unfold mkRhsStop ty is_rec bndr_dmd = Stop ty (RhsCtxt is_rec) (subDemandIfEvaluated bndr_dmd) -mkLazyArgStop :: OutType -> ArgInfo -> SimplCont -mkLazyArgStop ty fun_info = Stop ty (lazyArgContext fun_info) arg_sd +mkLazyArgStop :: OutType -> Maybe ArgInfo -> SimplCont +mkLazyArgStop ty Nothing = mkBoringStop ty +mkLazyArgStop ty (Just fun_info) = Stop ty (lazyArgContext fun_info) arg_sd where arg_sd = subDemandIfEvaluated (Partial.head (ai_dmds fun_info)) @@ -1859,11 +1860,12 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpandRhs env bind_cxt bndr rhs - | do_eta_expand -- If the current manifest arity isn't enough - -- (never true for join points) - , seEtaExpand env -- and eta-expansion is on - , wantEtaExpansion rhs - = -- Do eta-expansion. + | seEtaExpand env -- If Eta-expansion is on + , wantEtaExpansion rhs -- and we'd like to eta-expand e + , do_eta_expand -- and e's manifest arity is lower than + -- what it could be + -- (never true for join points) + = -- Do eta-expansion. assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ -- assert: this never happens for join points; see GHC.Core.Opt.Arity -- Note [Do not eta-expand join points] ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1491,7 +1491,12 @@ cpeArg env dmd arg ; if okCpeArg arg2 then do { v <- newVar arg_ty - ; let arg3 = cpeEtaExpand (exprArity arg2) arg2 + ; let ao = cp_arityOpts (cpe_config env) + -- See Note [Eta expansion of arguments in CorePrep] + ; let arg3 | Just at <- exprEtaExpandArity ao arg2 + = cpeEtaExpand (arityTypeArity at) arg2 + | otherwise + = arg2 arg_float = mkFloat env dmd is_unlifted v arg3 ; return (addFloat floats2 arg_float, varToCoreExpr v) } else return (floats2, arg2) @@ -1614,6 +1619,34 @@ and now we do NOT want eta expansion to give Instead GHC.Core.Opt.Arity.etaExpand gives f = /\a -> \y -> let s = h 3 in g s y +Note [Eta expansion of arguments in CorePrep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We eta expand arguments in here, in CorePrep, rather than in the Simplifier, and +do so based on 'exprEtaExpandArity' rather than the cheaper 'exprArity' analysis +we do on let RHSs and lambdas. The reason for the latter is that the Simplifier +has already run the more costly analysis on lambdas and let RHSs and eta +expanded accordingly, while it does not try to eta expand arguments at all. + +So why eta expand arguments in CorePrep rather than in the Simplifier? +There are two reasons why eta expansion of arguments is useful + + 1. In expressions like @f (h `seq` (g $))@ (from T23083) eta expanding the + argument to @f (\x -> h `seq` (g $ x))@ allows us to save allocation of a + closure and have a faster call sequence; a code-gen matter. + + 2. The eta expansion to @f (\x -> h `seq` (g $ x))@ gives rise to another + opportunity: We could inline ($), saving call overhead and perhaps turning + an unknown call into a known call. In general, there could be further + simplification based on the structure of the concrete argument `x`. + +To profit from (1), it is enough to eta expand in CorePrep, while (2) shows +that in some rare cases as above, eta expansion of arguments may enable +further simplification. CorePrep would not allow to exploit (2), while eta +expansion in the Simplifier would. + +Alas, trying to eta expand arguments in every round of the Simplifier is costly +(!10088 measured a geom. mean of +2.0% regression in ghc/alloc perf, regressing +as much as 27.2%), so we only exploit (1) for now. -} cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs @@ -1977,6 +2010,9 @@ data CorePrepConfig = CorePrepConfig , cp_convertNumLit :: !(LitNumType -> Integer -> Maybe CoreExpr) -- ^ Convert some numeric literals (Integer, Natural) into their final -- Core form. + + , cp_arityOpts :: !ArityOpts + -- ^ Configuration for arity analysis ('exprEtaExpandArity'). } data CorePrepEnv @@ -1987,6 +2023,7 @@ data CorePrepEnv -- enabled we instead produce an 'error' expression to catch -- the case where a function we think should bottom -- unexpectedly returns. + , cpe_env :: IdEnv CoreExpr -- Clone local Ids -- ^ This environment is used for three operations: -- ===================================== compiler/GHC/Driver/Config/CoreToStg/Prep.hs ===================================== @@ -9,6 +9,7 @@ import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Config.Core.Lint +import GHC.Driver.Config.Core.Opt.Arity import GHC.Tc.Utils.Env import GHC.Types.Var import GHC.Utils.Outputable ( alwaysQualify ) @@ -17,14 +18,16 @@ import GHC.CoreToStg.Prep initCorePrepConfig :: HscEnv -> IO CorePrepConfig initCorePrepConfig hsc_env = do + let dflags = hsc_dflags hsc_env convertNumLit <- do - let platform = targetPlatform $ hsc_dflags hsc_env + let platform = targetPlatform dflags home_unit = hsc_home_unit hsc_env lookup_global = lookupGlobal hsc_env mkConvertNumLiteral platform home_unit lookup_global return $ CorePrepConfig { cp_catchNonexhaustiveCases = gopt Opt_CatchNonexhaustiveCases $ hsc_dflags hsc_env , cp_convertNumLit = convertNumLit + , cp_arityOpts = initArityOpts dflags } initCorePrepPgmConfig :: DynFlags -> [Var] -> CorePrepPgmConfig ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -115,8 +115,8 @@ genCommonCppDefs profiling = mconcat -- GHCJS.Prim.JSVal , if profiling - then "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)\n" - else "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x))\n" + then "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM))\n" + else "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x)))\n" , "#define JSVAL_VAL(x) ((x).d1)\n" -- GHCJS.Prim.JSException ===================================== rts/js/rts.js ===================================== @@ -365,14 +365,7 @@ function h$printReg(r) { } else if(r.f.t === h$ct_blackhole && r.x) { return ("blackhole: -> " + h$printReg({ f: r.x.x1, d: r.d1.x2 }) + ")"); } else { - var iv = ""; - if(r.f.n === "integer-gmp:GHC.Integer.Type.Jp#" || - r.f.n === "integer-gmp:GHC.Integer.Type.Jn#") { - iv = ' [' + r.d1.join(',') + '](' + h$ghcjsbn_showBase(r.d1, 10) + ')' - } else if(r.f.n === "integer-gmp:GHC.Integer.Type.S#") { - iv = ' (S: ' + r.d1 + ')'; - } - return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")" + iv); + return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")"); } } else if(typeof r === 'object') { var res = h$collectProps(r); @@ -536,14 +529,7 @@ function h$dumpStackTop(stack, start, sp) { if(s.f.t === h$ct_blackhole && s.d1 && s.d1.x1 && s.d1.x1.n) { h$log("stack[" + i + "] = blackhole -> " + s.d1.x1.n); } else { - var iv = ""; - if(s.f.n === "integer-gmp:GHC.Integer.Type.Jp#" || - s.f.n === "integer-gmp:GHC.Integer.Type.Jn#") { - iv = ' [' + s.d1.join(',') + '](' + h$ghcjsbn_showBase(s.d1, 10) + ')' - } else if(s.f.n === "integer-gmp:GHC.Integer.Type.S#") { - iv = ' (S: ' + s.d1 + ')'; - } - h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")" + iv); + h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")"); } } } else if(h$isInstanceOf(s,h$MVar)) { ===================================== testsuite/tests/simplCore/should_compile/T23083.hs ===================================== @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +module T23083 where + +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +g f h = f (h `seq` (h $)) ===================================== testsuite/tests/simplCore/should_compile/T23083.stderr ===================================== @@ -0,0 +1,36 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 21, types: 17, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 6, types: 6, coercions: 0, joins: 0/0} +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +[GblId, Arity=2, Str=<1C(1,L)>, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60] 50 0}] +g = \ (f :: (Integer -> Integer) -> Integer) (h :: Integer -> Integer) -> f (\ (eta :: Integer) -> h eta) + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule4 :: GHC.Prim.Addr# +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T23083.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule3 :: GHC.Types.TrName +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule3 = GHC.Types.TrNameS T23083.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule2 :: GHC.Prim.Addr# +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T23083.$trModule2 = "T23083"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule1 :: GHC.Types.TrName +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule1 = GHC.Types.TrNameS T23083.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule :: GHC.Types.Module +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule = GHC.Types.Module T23083.$trModule3 T23083.$trModule1 + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) +test('T23083', [ grep_errmsg(r'f.*eta') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dppr-cols=99999']) ===================================== testsuite/tests/stranal/should_compile/T22997.hs ===================================== @@ -0,0 +1,9 @@ +module T22997 where + +{-# OPAQUE trivial #-} +trivial :: Int -> Int +trivial = succ + +{-# OPAQUE pap #-} +pap :: Integer -> Integer +pap = (42 +) ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -88,3 +88,5 @@ test('EtaExpansion', normal, compile, ['']) test('T22039', normal, compile, ['']) # T22388: Should see $winteresting but not $wboring test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) +# T22997: Just a panic that should not happen +test('T22997', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ca0c05b598353177cec46d4a508ea725d282f09...c4fbfb8cedcabc0badcb4d89613177164d778460 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ca0c05b598353177cec46d4a508ea725d282f09...c4fbfb8cedcabc0badcb4d89613177164d778460 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 10:15:11 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Mon, 13 Mar 2023 06:15:11 -0400 Subject: [Git][ghc/ghc][wip/T23083] 2 commits: Simplify: Simplification of arguments in a single function Message-ID: <640ef7af60a3f_36ed6c48bd876843084c@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: fe11dd9d by Sebastian Graf at 2023-03-13T11:15:00+01:00 Simplify: Simplification of arguments in a single function The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`, which seems to be the main way to simplify args. Hence I consolidated the code path to call `simplArg`, too, renaming to `simplLazyArg`. - - - - - 28fd1e10 by Sebastian Graf at 2023-03-13T11:15:03+01:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. Fixes #23083. - - - - - 7 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - + testsuite/tests/simplCore/should_compile/T23083.hs - + testsuite/tests/simplCore/should_compile/T23083.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -1517,7 +1517,7 @@ rebuild env expr cont ApplyToVal { sc_arg = arg, sc_env = se, sc_dup = dup_flag , sc_cont = cont, sc_hole_ty = fun_ty } -- See Note [Avoid redundant simplification] - -> do { (_, _, arg') <- simplArg env dup_flag fun_ty se arg + -> do { (_, _, arg') <- simplLazyArg env dup_flag fun_ty Nothing se arg ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv @@ -1633,7 +1633,6 @@ simplCast env body co0 cont0 , sc_hole_ty = coercionLKind co }) } -- NB! As the cast goes past, the -- type of the hole changes (#16312) - -- (f |> co) e ===> (f (e |> co1)) |> co2 -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 @@ -1652,7 +1651,7 @@ simplCast env body co0 cont0 -- See Note [Avoiding exponential behaviour] MCo co1 -> - do { (dup', arg_se', arg') <- simplArg env dup fun_ty arg_se arg + do { (dup', arg_se', arg') <- simplLazyArg env dup fun_ty Nothing arg_se arg -- When we build the ApplyTo we can't mix the OutCoercion -- 'co' with the InExpr 'arg', so we simplify -- to make it all consistent. It's a bit messy. @@ -1678,16 +1677,18 @@ simplCast env body co0 cont0 -- See Note [Representation polymorphism invariants] in GHC.Core -- test: typecheck/should_run/EtaExpandLevPoly -simplArg :: SimplEnv -> DupFlag - -> OutType -- Type of the function applied to this arg - -> StaticEnv -> CoreExpr -- Expression with its static envt - -> SimplM (DupFlag, StaticEnv, OutExpr) -simplArg env dup_flag fun_ty arg_env arg +simplLazyArg :: SimplEnv -> DupFlag + -> OutType -- Type of the function applied to this arg + -> Maybe ArgInfo + -> StaticEnv -> CoreExpr -- Expression with its static envt + -> SimplM (DupFlag, StaticEnv, OutExpr) +simplLazyArg env dup_flag fun_ty mb_arg_info arg_env arg | isSimplified dup_flag = return (dup_flag, arg_env, arg) | otherwise = do { let arg_env' = arg_env `setInScopeFromE` env - ; arg' <- simplExprC arg_env' arg (mkBoringStop (funArgTy fun_ty)) + ; let arg_ty = funArgTy fun_ty + ; arg' <- simplExprC arg_env' arg (mkLazyArgStop arg_ty mb_arg_info) ; return (Simplified, zapSubstEnv arg_env', arg') } -- Return a StaticEnv that includes the in-scope set from 'env', -- because arg' may well mention those variables (#20639) @@ -2281,12 +2282,8 @@ rebuildCall env fun_info -- There is no benefit (unlike in a let-binding), and we'd -- have to be very careful about bogus strictness through -- floating a demanded let. - = do { arg' <- simplExprC (arg_se `setInScopeFromE` env) arg - (mkLazyArgStop arg_ty fun_info) + = do { (_, _, arg') <- simplLazyArg env dup_flag fun_ty (Just fun_info) arg_se arg ; rebuildCall env (addValArgTo fun_info arg' fun_ty) cont } - where - arg_ty = funArgTy fun_ty - ---------- No further useful info, revert to generic rebuild ------------ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont @@ -3723,7 +3720,7 @@ mkDupableContWithDmds env dmds do { let (dmd:cont_dmds) = dmds -- Never fails ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 - ; (_, se', arg') <- simplArg env' dup hole_ty se arg + ; (_, se', arg') <- simplLazyArg env' dup hole_ty Nothing se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ; let all_floats = floats1 `addLetFloats` let_floats2 ; return ( all_floats ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -461,8 +461,9 @@ mkRhsStop :: OutType -> RecFlag -> Demand -> SimplCont -- See Note [RHS of lets] in GHC.Core.Unfold mkRhsStop ty is_rec bndr_dmd = Stop ty (RhsCtxt is_rec) (subDemandIfEvaluated bndr_dmd) -mkLazyArgStop :: OutType -> ArgInfo -> SimplCont -mkLazyArgStop ty fun_info = Stop ty (lazyArgContext fun_info) arg_sd +mkLazyArgStop :: OutType -> Maybe ArgInfo -> SimplCont +mkLazyArgStop ty Nothing = mkBoringStop ty +mkLazyArgStop ty (Just fun_info) = Stop ty (lazyArgContext fun_info) arg_sd where arg_sd = subDemandIfEvaluated (Partial.head (ai_dmds fun_info)) ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1491,7 +1491,12 @@ cpeArg env dmd arg ; if okCpeArg arg2 then do { v <- newVar arg_ty - ; let arg3 = cpeEtaExpand (exprArity arg2) arg2 + ; let ao = cp_arityOpts (cpe_config env) + -- See Note [Eta expansion of arguments in CorePrep] + ; let arg3 | Just at <- exprEtaExpandArity ao arg2 + = cpeEtaExpand (arityTypeArity at) arg2 + | otherwise + = arg2 arg_float = mkFloat env dmd is_unlifted v arg3 ; return (addFloat floats2 arg_float, varToCoreExpr v) } else return (floats2, arg2) @@ -1614,6 +1619,34 @@ and now we do NOT want eta expansion to give Instead GHC.Core.Opt.Arity.etaExpand gives f = /\a -> \y -> let s = h 3 in g s y +Note [Eta expansion of arguments in CorePrep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We eta expand arguments in here, in CorePrep, rather than in the Simplifier, and +do so based on 'exprEtaExpandArity' rather than the cheaper 'exprArity' analysis +we do on let RHSs and lambdas. The reason for the latter is that the Simplifier +has already run the more costly analysis on lambdas and let RHSs and eta +expanded accordingly, while it does not try to eta expand arguments at all. + +So why eta expand arguments in CorePrep rather than in the Simplifier? +There are two reasons why eta expansion of arguments is useful + + 1. In expressions like @f (h `seq` (g $))@ (from T23083) eta expanding the + argument to @f (\x -> h `seq` (g $ x))@ allows us to save allocation of a + closure and have a faster call sequence; a code-gen matter. + + 2. The eta expansion to @f (\x -> h `seq` (g $ x))@ gives rise to another + opportunity: We could inline ($), saving call overhead and perhaps turning + an unknown call into a known call. In general, there could be further + simplification based on the structure of the concrete argument `x`. + +To profit from (1), it is enough to eta expand in CorePrep, while (2) shows +that in some rare cases as above, eta expansion of arguments may enable +further simplification. CorePrep would not allow to exploit (2), while eta +expansion in the Simplifier would. + +Alas, trying to eta expand arguments in every round of the Simplifier is costly +(!10088 measured a geom. mean of +2.0% regression in ghc/alloc perf, regressing +as much as 27.2%), so we only exploit (1) for now. -} cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs @@ -1977,6 +2010,9 @@ data CorePrepConfig = CorePrepConfig , cp_convertNumLit :: !(LitNumType -> Integer -> Maybe CoreExpr) -- ^ Convert some numeric literals (Integer, Natural) into their final -- Core form. + + , cp_arityOpts :: !ArityOpts + -- ^ Configuration for arity analysis ('exprEtaExpandArity'). } data CorePrepEnv @@ -1987,6 +2023,7 @@ data CorePrepEnv -- enabled we instead produce an 'error' expression to catch -- the case where a function we think should bottom -- unexpectedly returns. + , cpe_env :: IdEnv CoreExpr -- Clone local Ids -- ^ This environment is used for three operations: -- ===================================== compiler/GHC/Driver/Config/CoreToStg/Prep.hs ===================================== @@ -9,6 +9,7 @@ import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Config.Core.Lint +import GHC.Driver.Config.Core.Opt.Arity import GHC.Tc.Utils.Env import GHC.Types.Var import GHC.Utils.Outputable ( alwaysQualify ) @@ -17,14 +18,16 @@ import GHC.CoreToStg.Prep initCorePrepConfig :: HscEnv -> IO CorePrepConfig initCorePrepConfig hsc_env = do + let dflags = hsc_dflags hsc_env convertNumLit <- do - let platform = targetPlatform $ hsc_dflags hsc_env + let platform = targetPlatform dflags home_unit = hsc_home_unit hsc_env lookup_global = lookupGlobal hsc_env mkConvertNumLiteral platform home_unit lookup_global return $ CorePrepConfig { cp_catchNonexhaustiveCases = gopt Opt_CatchNonexhaustiveCases $ hsc_dflags hsc_env , cp_convertNumLit = convertNumLit + , cp_arityOpts = initArityOpts dflags } initCorePrepPgmConfig :: DynFlags -> [Var] -> CorePrepPgmConfig ===================================== testsuite/tests/simplCore/should_compile/T23083.hs ===================================== @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +module T23083 where + +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +g f h = f (h `seq` (h $)) ===================================== testsuite/tests/simplCore/should_compile/T23083.stderr ===================================== @@ -0,0 +1,36 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 21, types: 17, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 6, types: 6, coercions: 0, joins: 0/0} +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +[GblId, Arity=2, Str=<1C(1,L)>, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60] 50 0}] +g = \ (f :: (Integer -> Integer) -> Integer) (h :: Integer -> Integer) -> f (\ (eta :: Integer) -> h eta) + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule4 :: GHC.Prim.Addr# +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T23083.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule3 :: GHC.Types.TrName +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule3 = GHC.Types.TrNameS T23083.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule2 :: GHC.Prim.Addr# +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T23083.$trModule2 = "T23083"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule1 :: GHC.Types.TrName +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule1 = GHC.Types.TrNameS T23083.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule :: GHC.Types.Module +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule = GHC.Types.Module T23083.$trModule3 T23083.$trModule1 + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) +test('T23083', [ grep_errmsg(r'f.*eta') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dppr-cols=99999']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4fbfb8cedcabc0badcb4d89613177164d778460...28fd1e10250801179a91e73fdf03dfa095fca177 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4fbfb8cedcabc0badcb4d89613177164d778460...28fd1e10250801179a91e73fdf03dfa095fca177 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 10:21:04 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Mon, 13 Mar 2023 06:21:04 -0400 Subject: [Git][ghc/ghc][wip/T23083] CorePrep: Eta expand arguments (#23083) Message-ID: <640ef9103e285_36ed6c48dd3f18431155@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: 0492a3a7 by Sebastian Graf at 2023-03-13T11:20:57+01:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. Fixes #23083. - - - - - 5 changed files: - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - + testsuite/tests/simplCore/should_compile/T23083.hs - + testsuite/tests/simplCore/should_compile/T23083.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1491,7 +1491,12 @@ cpeArg env dmd arg ; if okCpeArg arg2 then do { v <- newVar arg_ty - ; let arg3 = cpeEtaExpand (exprArity arg2) arg2 + ; let ao = cp_arityOpts (cpe_config env) + -- See Note [Eta expansion of arguments in CorePrep] + ; let arg3 | Just at <- exprEtaExpandArity ao arg2 + = cpeEtaExpand (arityTypeArity at) arg2 + | otherwise + = arg2 arg_float = mkFloat env dmd is_unlifted v arg3 ; return (addFloat floats2 arg_float, varToCoreExpr v) } else return (floats2, arg2) @@ -1614,6 +1619,36 @@ and now we do NOT want eta expansion to give Instead GHC.Core.Opt.Arity.etaExpand gives f = /\a -> \y -> let s = h 3 in g s y +Note [Eta expansion of arguments in CorePrep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We eta expand arguments in here, in CorePrep, rather than in the Simplifier, and +do so based on 'exprEtaExpandArity' rather than the cheaper 'exprArity' analysis +we do on let RHSs and lambdas. The reason for the latter is that the Simplifier +has already run the more costly analysis on lambdas and let RHSs and eta +expanded accordingly, while it does not try to eta expand arguments at all. + +So why eta expand arguments in CorePrep rather than in the Simplifier? +There are two reasons why eta expansion of arguments is useful + + 1. In expressions like @f (h `seq` (g $))@ (from T23083) eta expanding the + argument to @f (\x -> h `seq` (g $ x))@ allows us to save allocation of a + closure and have a faster call sequence; a code-gen matter. + + 2. The eta expansion to @f (\x -> h `seq` (g $ x))@ gives rise to another + opportunity: We could inline ($), saving call overhead and perhaps turning + an unknown call into a known call. In general, there could be further + simplification based on the structure of the concrete argument `x`. + Whether we should inline in the PAP `(g $)` (thus solving this problem + independently of (1)) is discussed in #22886. + +To profit from (1), it is enough to eta expand in CorePrep, while (2) shows +that in some rare cases as above, eta expansion of arguments may enable +further simplification. CorePrep would not allow to exploit (2), while eta +expansion in the Simplifier would. + +Alas, trying to eta expand arguments in every round of the Simplifier is costly +(!10088 measured a geom. mean of +2.0% regression in ghc/alloc perf, regressing +as much as 27.2%), so we only exploit (1) for now. -} cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs @@ -1977,6 +2012,9 @@ data CorePrepConfig = CorePrepConfig , cp_convertNumLit :: !(LitNumType -> Integer -> Maybe CoreExpr) -- ^ Convert some numeric literals (Integer, Natural) into their final -- Core form. + + , cp_arityOpts :: !ArityOpts + -- ^ Configuration for arity analysis ('exprEtaExpandArity'). } data CorePrepEnv @@ -1987,6 +2025,7 @@ data CorePrepEnv -- enabled we instead produce an 'error' expression to catch -- the case where a function we think should bottom -- unexpectedly returns. + , cpe_env :: IdEnv CoreExpr -- Clone local Ids -- ^ This environment is used for three operations: -- ===================================== compiler/GHC/Driver/Config/CoreToStg/Prep.hs ===================================== @@ -9,6 +9,7 @@ import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Config.Core.Lint +import GHC.Driver.Config.Core.Opt.Arity import GHC.Tc.Utils.Env import GHC.Types.Var import GHC.Utils.Outputable ( alwaysQualify ) @@ -17,14 +18,16 @@ import GHC.CoreToStg.Prep initCorePrepConfig :: HscEnv -> IO CorePrepConfig initCorePrepConfig hsc_env = do + let dflags = hsc_dflags hsc_env convertNumLit <- do - let platform = targetPlatform $ hsc_dflags hsc_env + let platform = targetPlatform dflags home_unit = hsc_home_unit hsc_env lookup_global = lookupGlobal hsc_env mkConvertNumLiteral platform home_unit lookup_global return $ CorePrepConfig { cp_catchNonexhaustiveCases = gopt Opt_CatchNonexhaustiveCases $ hsc_dflags hsc_env , cp_convertNumLit = convertNumLit + , cp_arityOpts = initArityOpts dflags } initCorePrepPgmConfig :: DynFlags -> [Var] -> CorePrepPgmConfig ===================================== testsuite/tests/simplCore/should_compile/T23083.hs ===================================== @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +module T23083 where + +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +g f h = f (h `seq` (h $)) ===================================== testsuite/tests/simplCore/should_compile/T23083.stderr ===================================== @@ -0,0 +1,36 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 21, types: 17, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 6, types: 6, coercions: 0, joins: 0/0} +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +[GblId, Arity=2, Str=<1C(1,L)>, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60] 50 0}] +g = \ (f :: (Integer -> Integer) -> Integer) (h :: Integer -> Integer) -> f (\ (eta :: Integer) -> h eta) + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule4 :: GHC.Prim.Addr# +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T23083.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule3 :: GHC.Types.TrName +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule3 = GHC.Types.TrNameS T23083.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule2 :: GHC.Prim.Addr# +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T23083.$trModule2 = "T23083"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule1 :: GHC.Types.TrName +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule1 = GHC.Types.TrNameS T23083.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule :: GHC.Types.Module +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] +T23083.$trModule = GHC.Types.Module T23083.$trModule3 T23083.$trModule1 + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) +test('T23083', [ grep_errmsg(r'f.*eta') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dppr-cols=99999']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0492a3a73e990adb93cc93b19e4f964161a0528f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0492a3a73e990adb93cc93b19e4f964161a0528f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 11:31:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 13 Mar 2023 07:31:05 -0400 Subject: [Git][ghc/ghc][master] JS: fix implementation of forceBool to use JS backend syntax Message-ID: <640f09793453f_36ed6c4a2c230c446499@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 4 changed files: - compiler/GHC/HsToCore/Foreign/JavaScript.hs - + testsuite/tests/javascript/T23101.hs - + testsuite/tests/javascript/T23101.stdout - + testsuite/tests/javascript/all.T Changes: ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -639,7 +639,7 @@ jsResultWrapper result_ty | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey = do -- result_id <- newSysLocalDs boolTy ccall_uniq <- newUnique - let forceBool e = mkJsCall ccall_uniq (fsLit "$r = !(!$1)") [e] boolTy + let forceBool e = mkJsCall ccall_uniq (fsLit "((x) => { return !(!x); })") [e] boolTy return (Just intPrimTy, \e -> forceBool e) ===================================== testsuite/tests/javascript/T23101.hs ===================================== @@ -0,0 +1,22 @@ + +foreign import javascript "(($1) => { return $1; })" + bool_id :: Bool -> Bool + +foreign import javascript "(($1) => { return !$1; })" + bool_not :: Bool -> Bool + +foreign import javascript "(($1) => { console.log($1); })" + bool_log :: Bool -> IO () + +main :: IO () +main = do + bool_log True + bool_log False + bool_log (bool_id True) + bool_log (bool_id False) + bool_log (bool_not True) + bool_log (bool_not False) + print (bool_id True) + print (bool_id False) + print (bool_not True) + print (bool_not False) ===================================== testsuite/tests/javascript/T23101.stdout ===================================== @@ -0,0 +1,10 @@ +true +false +true +false +false +true +True +False +False +True ===================================== testsuite/tests/javascript/all.T ===================================== @@ -0,0 +1,4 @@ +# These are JavaScript-specific tests +setTestOpts(when(not(js_arch()),skip)) + +test('T23101', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/047e9d4f10e4124899887449dc52b9e72a7d3ea6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/047e9d4f10e4124899887449dc52b9e72a7d3ea6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 11:31:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 13 Mar 2023 07:31:42 -0400 Subject: [Git][ghc/ghc][master] Simplifier: `countValArgs` should not count Type args (#23102) Message-ID: <640f099e9c9ad_36ed6c4a38ccb04514fb@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -553,7 +553,7 @@ countArgs _ = 0 countValArgs :: SimplCont -> Int -- Count value arguments only -countValArgs (ApplyToTy { sc_cont = cont }) = 1 + countValArgs cont +countValArgs (ApplyToTy { sc_cont = cont }) = countValArgs cont countValArgs (ApplyToVal { sc_cont = cont }) = 1 + countValArgs cont countValArgs (CastIt _ cont) = countValArgs cont countValArgs _ = 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/559a480427a841b5189f2e6a84a38b02a7c2b8a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/559a480427a841b5189f2e6a84a38b02a7c2b8a1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 12:37:51 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 13 Mar 2023 08:37:51 -0400 Subject: [Git][ghc/ghc][wip/jsem] 494 commits: Correct `exitWith` Haddocks Message-ID: <640f191fb968f_36ed6c4b7509b8459034@gitlab.mail> Matthew Pickering pushed to branch wip/jsem at Glasgow Haskell Compiler / GHC Commits: 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - de3c6ac6 by sheaf at 2023-03-13T12:14:33+00:00 parent ad612f555821a44260e5d9654f940b71f5180817 author sheaf <sam.derbyshire at gmail.com> 1662553354 +0200 committer Matthew Pickering <matthewtpickering at gmail.com> 1671366685 +0000 WIP: jsem, using POSIX/Win32 semaphores Updates submodule - - - - - e9dc0795 by sheaf at 2023-03-13T12:14:35+00:00 some rewording of jsem notes - - - - - 6b241e1a by Matthew Pickering at 2023-03-13T12:19:29+00:00 fixes - - - - - 21 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/hello.hs - + .gitlab/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - + .gitlab/rel_eng/default.nix - + .gitlab/rel_eng/fetch-gitlab-artifacts/.gitignore - + .gitlab/rel_eng/fetch-gitlab-artifacts/README.mkd - + .gitlab/rel_eng/fetch-gitlab-artifacts/default.nix - + .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - + .gitlab/rel_eng/fetch-gitlab-artifacts/setup.py - + .gitlab/rel_eng/mk-ghcup-metadata/.gitignore - + .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - + .gitlab/rel_eng/mk-ghcup-metadata/default.nix The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ce502b65968ed27457d2575fd058a8e4c84873b...6b241e1aa48b29bb5fc5127cb35ceb92d1c44523 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ce502b65968ed27457d2575fd058a8e4c84873b...6b241e1aa48b29bb5fc5127cb35ceb92d1c44523 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 14:05:08 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 13 Mar 2023 10:05:08 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/bump-w32 Message-ID: <640f2d94b4799_36ed6c4ced03b84755b0@gitlab.mail> Matthew Pickering pushed new branch wip/bump-w32 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/bump-w32 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 14:08:18 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 13 Mar 2023 10:08:18 -0400 Subject: [Git][ghc/ghc][wip/expand-do] Start of HsExpand for HsDo Fixes for #18324 Message-ID: <640f2e52629fb_36ed6c4cfb7b504775a1@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 4a45f03f by Apoorv Ingle at 2023-03-13T09:07:55-05:00 Start of HsExpand for HsDo Fixes for #18324 - - - - - 2 changed files: - compiler/GHC/Rename/Expr.hs - + testsuite/tests/rebindable/T18324.hs Changes: ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -433,7 +433,10 @@ rnExpr (HsDo _ do_or_lc (L l stmts)) rnStmtsWithFreeVars (HsDoStmt do_or_lc) rnExpr stmts (\ _ -> return ((), emptyFVs)) ; (pp_stmts, fvs2) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 - ; return ( HsDo noExtField do_or_lc (L l pp_stmts), fvs1 `plusFV` fvs2 ) } + ; let orig_do_block = HsDo noExtField do_or_lc (L l pp_stmts) + expd_do_block = expand_do_stmts pp_stmts + ; return ( mkExpandedExpr orig_do_block expd_do_block + , fvs1 `plusFV` fvs2 ) } -- ExplicitList: see Note [Handling overloaded and rebindable constructs] rnExpr (ExplicitList _ exps) @@ -1165,7 +1168,7 @@ rnStmt ctxt rnBody (L loc (LastStmt _ (L lb body) noret _)) thing_inside else return (noSyntaxExpr, emptyFVs) -- The 'return' in a LastStmt is used only -- for MonadComp; and we don't want to report - -- "non in scope: return" in other cases + -- "not in scope: return" in other cases -- #15607 ; (thing, fvs3) <- thing_inside [] @@ -2703,6 +2706,56 @@ mkExpandedExpr -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedExpr a b = XExpr (HsExpanded a b) + + +-- | Expand the Do statments so that it works fine with Quicklook +-- See Note[Rebindable Do Expanding Statements] +-- ANI Questions: 1. What should be the location information in the expanded expression? Currently the error is still displayed on the expanded expr and not on the unexpanded expr +-- 2. Need to figure out the exact cases where this function needs to be called. It fails on lists +-- 3. Convert let statements into expanded version. +-- 4. hopefully the co-recursive cases won't get affected by this expansion +expand_do_stmts :: [ExprLStmt GhcRn] -> HsExpr GhcRn + +expand_do_stmts [L _ (LastStmt _ body _ NoSyntaxExprRn)] +-- TODO: not sure about this maybe this never happens in a do block? +-- This does happen in a list comprehension though +-- = genHsApp (genHsVar returnMName) body + = unLoc body + +expand_do_stmts [L l (LastStmt _ body _ (SyntaxExprRn ret))] +-- +-- ------------------------------------------------ +-- return e ~~> return e +-- definitely works T18324.hs + = unLoc $ mkHsApp (L l ret) body + +expand_do_stmts ((L l (BindStmt _ x e)):lstmts) +-- stmts ~~> stmt' +-- ------------------------------------------------ +-- x <- e ; stmts ~~> (Prelude.>>=) e (\ x -> stmts' ) + = genHsApps bindMName -- (>>=) + [ e -- e + , mkHsLam [x] (L l $ expand_do_stmts lstmts) -- (\ x -> stmts') + ] +-- expand_do_stmts ((L l (LetStmt _ x e)):lstmts) = undefined +-- stmts ~~> stmts' +-- ------------------------------------------------ +-- let x = e ; stmts ~~> let x = e in stmts' + +expand_do_stmts ((L l (BodyStmt _ e (SyntaxExprRn f) _)):lstmts) +-- stmts ~~> stmts' +-- ---------------------------------------------- +-- e ; stmts ~~> (Prelude.>>) e (\ _ -> stmt') + = unLoc $ nlHsApp (nlHsApp (L l f) -- (>>) See Note [BodyStmt] + e) + $ mkHsLam [] (L l $ expand_do_stmts lstmts) + +-- expand_do_stmts ((L l (TransStmt {})):lstmts) = undefined +-- expand_do_stmts ((L l (RecStmt {})):lstmts) = undefined + +-- expand_do_stmts (stmt@(L _ (ParStmt {})):_) = pprPanic "expand_do_stmts: impossible happened" $ ppr stmt +expand_do_stmts stmt = pprPanic "expand_do_stmts: impossible happened" $ ppr stmt + ----------------------------------------- -- Bits and pieces for RecordDotSyntax. -- ===================================== testsuite/tests/rebindable/T18324.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE ImpredicativeTypes, DeriveAnyClass #-} +module T18324 where + + +type Id = forall a. a -> a + +t :: IO Id +t = return id + +p :: Id -> (Bool, Int) +p f = (f True, f 3) + +foo1 = t >>= \x -> return (p x) + +foo2 = do { x <- t ; return (p x) } + + +-- data State a s = S (a, s) deriving (Functor, Applicative, Monad) + +-- update :: State a s -> (s -> s) -> State a s +-- update (S (a, s)) f = S (a, f s) + + +-- ts :: State Int Id +-- ts = return id + +-- foo3 = do { x <- ts ; update ts ; return (p x) } + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a45f03ff176a0a1cfb8d46947c0b18d1442b8d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a45f03ff176a0a1cfb8d46947c0b18d1442b8d7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 14:35:10 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Mon, 13 Mar 2023 10:35:10 -0400 Subject: [Git][ghc/ghc][wip/T23083] 5 commits: JS: fix implementation of forceBool to use JS backend syntax Message-ID: <640f349e14cf3_36ed6c4d58f19048472d@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - c63f7179 by Sebastian Graf at 2023-03-13T15:07:39+01:00 WorkWrap: Relax "splitFun" warning for join points (#23113) - - - - - 4e4d74ce by Sebastian Graf at 2023-03-13T15:07:48+01:00 Simplify: Simplification of arguments in a single function The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`, which seems to be the main way to simplify args. Hence I consolidated the code path to call `simplArg`, too, renaming to `simplLazyArg`. - - - - - 191b6fd8 by Sebastian Graf at 2023-03-13T15:34:59+01:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. Fixes #23083. - - - - - 13 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - + testsuite/tests/javascript/T23101.hs - + testsuite/tests/javascript/T23101.stdout - + testsuite/tests/javascript/all.T - + testsuite/tests/simplCore/should_compile/T23083.hs - + testsuite/tests/simplCore/should_compile/T23083.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -1517,7 +1517,7 @@ rebuild env expr cont ApplyToVal { sc_arg = arg, sc_env = se, sc_dup = dup_flag , sc_cont = cont, sc_hole_ty = fun_ty } -- See Note [Avoid redundant simplification] - -> do { (_, _, arg') <- simplArg env dup_flag fun_ty se arg + -> do { (_, _, arg') <- simplLazyArg env dup_flag fun_ty Nothing se arg ; rebuild env (App expr arg') cont } completeBindX :: SimplEnv @@ -1633,7 +1633,6 @@ simplCast env body co0 cont0 , sc_hole_ty = coercionLKind co }) } -- NB! As the cast goes past, the -- type of the hole changes (#16312) - -- (f |> co) e ===> (f (e |> co1)) |> co2 -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 @@ -1652,7 +1651,7 @@ simplCast env body co0 cont0 -- See Note [Avoiding exponential behaviour] MCo co1 -> - do { (dup', arg_se', arg') <- simplArg env dup fun_ty arg_se arg + do { (dup', arg_se', arg') <- simplLazyArg env dup fun_ty Nothing arg_se arg -- When we build the ApplyTo we can't mix the OutCoercion -- 'co' with the InExpr 'arg', so we simplify -- to make it all consistent. It's a bit messy. @@ -1678,16 +1677,18 @@ simplCast env body co0 cont0 -- See Note [Representation polymorphism invariants] in GHC.Core -- test: typecheck/should_run/EtaExpandLevPoly -simplArg :: SimplEnv -> DupFlag - -> OutType -- Type of the function applied to this arg - -> StaticEnv -> CoreExpr -- Expression with its static envt - -> SimplM (DupFlag, StaticEnv, OutExpr) -simplArg env dup_flag fun_ty arg_env arg +simplLazyArg :: SimplEnv -> DupFlag + -> OutType -- Type of the function applied to this arg + -> Maybe ArgInfo + -> StaticEnv -> CoreExpr -- Expression with its static envt + -> SimplM (DupFlag, StaticEnv, OutExpr) +simplLazyArg env dup_flag fun_ty mb_arg_info arg_env arg | isSimplified dup_flag = return (dup_flag, arg_env, arg) | otherwise = do { let arg_env' = arg_env `setInScopeFromE` env - ; arg' <- simplExprC arg_env' arg (mkBoringStop (funArgTy fun_ty)) + ; let arg_ty = funArgTy fun_ty + ; arg' <- simplExprC arg_env' arg (mkLazyArgStop arg_ty mb_arg_info) ; return (Simplified, zapSubstEnv arg_env', arg') } -- Return a StaticEnv that includes the in-scope set from 'env', -- because arg' may well mention those variables (#20639) @@ -2281,12 +2282,8 @@ rebuildCall env fun_info -- There is no benefit (unlike in a let-binding), and we'd -- have to be very careful about bogus strictness through -- floating a demanded let. - = do { arg' <- simplExprC (arg_se `setInScopeFromE` env) arg - (mkLazyArgStop arg_ty fun_info) + = do { (_, _, arg') <- simplLazyArg env dup_flag fun_ty (Just fun_info) arg_se arg ; rebuildCall env (addValArgTo fun_info arg' fun_ty) cont } - where - arg_ty = funArgTy fun_ty - ---------- No further useful info, revert to generic rebuild ------------ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont @@ -3723,7 +3720,7 @@ mkDupableContWithDmds env dmds do { let (dmd:cont_dmds) = dmds -- Never fails ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 - ; (_, se', arg') <- simplArg env' dup hole_ty se arg + ; (_, se', arg') <- simplLazyArg env' dup hole_ty Nothing se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ; let all_floats = floats1 `addLetFloats` let_floats2 ; return ( all_floats ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -461,8 +461,9 @@ mkRhsStop :: OutType -> RecFlag -> Demand -> SimplCont -- See Note [RHS of lets] in GHC.Core.Unfold mkRhsStop ty is_rec bndr_dmd = Stop ty (RhsCtxt is_rec) (subDemandIfEvaluated bndr_dmd) -mkLazyArgStop :: OutType -> ArgInfo -> SimplCont -mkLazyArgStop ty fun_info = Stop ty (lazyArgContext fun_info) arg_sd +mkLazyArgStop :: OutType -> Maybe ArgInfo -> SimplCont +mkLazyArgStop ty Nothing = mkBoringStop ty +mkLazyArgStop ty (Just fun_info) = Stop ty (lazyArgContext fun_info) arg_sd where arg_sd = subDemandIfEvaluated (Partial.head (ai_dmds fun_info)) @@ -553,7 +554,7 @@ countArgs _ = 0 countValArgs :: SimplCont -> Int -- Count value arguments only -countValArgs (ApplyToTy { sc_cont = cont }) = 1 + countValArgs cont +countValArgs (ApplyToTy { sc_cont = cont }) = countValArgs cont countValArgs (ApplyToVal { sc_cont = cont }) = 1 + countValArgs cont countValArgs (CastIt _ cont) = countValArgs cont countValArgs _ = 0 ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -758,9 +758,11 @@ by LitRubbish (see Note [Drop absent bindings]) so there is no great harm. splitFun :: WwOpts -> Id -> CoreExpr -> UniqSM [(Id, CoreExpr)] splitFun ww_opts fn_id rhs | Just (arg_vars, body) <- collectNValBinders_maybe (length wrap_dmds) rhs - = warnPprTrace (not (wrap_dmds `lengthIs` (arityInfo fn_info))) + = warnPprTrace (if isJoinId fn_id + then not (wrap_dmds `lengthAtMost` (arityInfo fn_info)) + else not (wrap_dmds `lengthIs` (arityInfo fn_info))) "splitFun" - (ppr fn_id <+> (ppr wrap_dmds $$ ppr cpr)) $ + (ppr fn_id <+> (ppr (arityInfo fn_info) $$ ppr wrap_dmds $$ ppr cpr)) $ do { mb_stuff <- mkWwBodies ww_opts fn_id arg_vars (exprType body) wrap_dmds cpr ; case mb_stuff of Nothing -> -- No useful wrapper; leave the binding alone ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -406,7 +406,7 @@ coreToStgExpr expr@(App _ _) -- rep might not be equal to rep2 -> return (StgLit $ LitRubbish TypeLike $ getRuntimeRep (exprType expr)) - _ -> pprPanic "coreToStgExpr - Invalid app head:" (ppr expr) + _ -> pprPanic "coreToStgExpr - Invalid app head:" (ppr app_head $$ ppr expr) where (app_head, args, ticks) = myCollectArgs expr coreToStgExpr expr@(Lam _ _) ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1491,12 +1491,26 @@ cpeArg env dmd arg ; if okCpeArg arg2 then do { v <- newVar arg_ty - ; let arg3 = cpeEtaExpand (exprArity arg2) arg2 + ; let ao = cp_arityOpts (cpe_config env) + -- See Note [Eta expansion of arguments in CorePrep] + ; let arg3 | Just at <- exprEtaExpandArity ao arg2 + , not (is_join arg2) + -- See Note [Eta expansion for join points] + -- Eta expanding the join point would + -- introduce crap that we can't generate + -- code for + = cpeEtaExpand (arityTypeArity at) arg2 + | otherwise + = arg2 arg_float = mkFloat env dmd is_unlifted v arg3 ; return (addFloat floats2 arg_float, varToCoreExpr v) } else return (floats2, arg2) } +is_join :: CoreExpr -> Bool +is_join (Let bs _) = isJoinBind bs +is_join _ = False + {- Note [Floating unlifted arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1614,6 +1628,36 @@ and now we do NOT want eta expansion to give Instead GHC.Core.Opt.Arity.etaExpand gives f = /\a -> \y -> let s = h 3 in g s y +Note [Eta expansion of arguments in CorePrep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We eta expand arguments in here, in CorePrep, rather than in the Simplifier, and +do so based on 'exprEtaExpandArity' rather than the cheaper 'exprArity' analysis +we do on let RHSs and lambdas. The reason for the latter is that the Simplifier +has already run the more costly analysis on lambdas and let RHSs and eta +expanded accordingly, while it does not try to eta expand arguments at all. + +So why eta expand arguments in CorePrep rather than in the Simplifier? +There are two reasons why eta expansion of arguments is useful + + 1. In expressions like @f (h `seq` (g $))@ (from T23083) eta expanding the + argument to @f (\x -> h `seq` (g $ x))@ allows us to save allocation of a + closure and have a faster call sequence; a code-gen matter. + + 2. The eta expansion to @f (\x -> h `seq` (g $ x))@ gives rise to another + opportunity: We could inline ($), saving call overhead and perhaps turning + an unknown call into a known call. In general, there could be further + simplification based on the structure of the concrete argument `x`. + Whether we should inline in the PAP `(g $)` (thus solving this problem + independently of (1)) is discussed in #22886. + +To profit from (1), it is enough to eta expand in CorePrep, while (2) shows +that in some rare cases as above, eta expansion of arguments may enable +further simplification. CorePrep would not allow to exploit (2), while eta +expansion in the Simplifier would. + +Alas, trying to eta expand arguments in every round of the Simplifier is costly +(!10088 measured a geom. mean of +2.0% regression in ghc/alloc perf, regressing +as much as 27.2%), so we only exploit (1) for now. -} cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs @@ -1977,6 +2021,9 @@ data CorePrepConfig = CorePrepConfig , cp_convertNumLit :: !(LitNumType -> Integer -> Maybe CoreExpr) -- ^ Convert some numeric literals (Integer, Natural) into their final -- Core form. + + , cp_arityOpts :: !ArityOpts + -- ^ Configuration for arity analysis ('exprEtaExpandArity'). } data CorePrepEnv @@ -1987,6 +2034,7 @@ data CorePrepEnv -- enabled we instead produce an 'error' expression to catch -- the case where a function we think should bottom -- unexpectedly returns. + , cpe_env :: IdEnv CoreExpr -- Clone local Ids -- ^ This environment is used for three operations: -- ===================================== compiler/GHC/Driver/Config/CoreToStg/Prep.hs ===================================== @@ -9,6 +9,7 @@ import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Config.Core.Lint +import GHC.Driver.Config.Core.Opt.Arity import GHC.Tc.Utils.Env import GHC.Types.Var import GHC.Utils.Outputable ( alwaysQualify ) @@ -17,14 +18,16 @@ import GHC.CoreToStg.Prep initCorePrepConfig :: HscEnv -> IO CorePrepConfig initCorePrepConfig hsc_env = do + let dflags = hsc_dflags hsc_env convertNumLit <- do - let platform = targetPlatform $ hsc_dflags hsc_env + let platform = targetPlatform dflags home_unit = hsc_home_unit hsc_env lookup_global = lookupGlobal hsc_env mkConvertNumLiteral platform home_unit lookup_global return $ CorePrepConfig { cp_catchNonexhaustiveCases = gopt Opt_CatchNonexhaustiveCases $ hsc_dflags hsc_env , cp_convertNumLit = convertNumLit + , cp_arityOpts = initArityOpts dflags } initCorePrepPgmConfig :: DynFlags -> [Var] -> CorePrepPgmConfig ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -639,7 +639,7 @@ jsResultWrapper result_ty | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey = do -- result_id <- newSysLocalDs boolTy ccall_uniq <- newUnique - let forceBool e = mkJsCall ccall_uniq (fsLit "$r = !(!$1)") [e] boolTy + let forceBool e = mkJsCall ccall_uniq (fsLit "((x) => { return !(!x); })") [e] boolTy return (Just intPrimTy, \e -> forceBool e) ===================================== testsuite/tests/javascript/T23101.hs ===================================== @@ -0,0 +1,22 @@ + +foreign import javascript "(($1) => { return $1; })" + bool_id :: Bool -> Bool + +foreign import javascript "(($1) => { return !$1; })" + bool_not :: Bool -> Bool + +foreign import javascript "(($1) => { console.log($1); })" + bool_log :: Bool -> IO () + +main :: IO () +main = do + bool_log True + bool_log False + bool_log (bool_id True) + bool_log (bool_id False) + bool_log (bool_not True) + bool_log (bool_not False) + print (bool_id True) + print (bool_id False) + print (bool_not True) + print (bool_not False) ===================================== testsuite/tests/javascript/T23101.stdout ===================================== @@ -0,0 +1,10 @@ +true +false +true +false +false +true +True +False +False +True ===================================== testsuite/tests/javascript/all.T ===================================== @@ -0,0 +1,4 @@ +# These are JavaScript-specific tests +setTestOpts(when(not(js_arch()),skip)) + +test('T23101', normal, compile_and_run, ['']) ===================================== testsuite/tests/simplCore/should_compile/T23083.hs ===================================== @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +module T23083 where + +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +g f h = f (h `seq` (h $)) ===================================== testsuite/tests/simplCore/should_compile/T23083.stderr ===================================== @@ -0,0 +1,42 @@ + +==================== CorePrep ==================== +Result size of CorePrep = {terms: 27, types: 24, coercions: 0, joins: 0/1} + +-- RHS size: {terms: 12, types: 13, coercions: 0, joins: 0/1} +T23083.g :: ((GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer) -> (GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer +[GblId, Arity=2, Str=<1C(1,L)>, Unf=OtherCon []] +T23083.g + = \ (f [Occ=Once1!] :: (GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer) (h [Occ=OnceL1] :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> + let { + sat [Occ=Once1] :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer + [LclId] + sat = \ (eta [Occ=Once1] :: GHC.Num.Integer.Integer) -> case h of h1 [Occ=Once1] { __DEFAULT -> GHC.Base.$ @GHC.Types.LiftedRep @GHC.Num.Integer.Integer @GHC.Num.Integer.Integer h1 eta } } in + f sat + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule4 :: GHC.Prim.Addr# +[GblId, Unf=OtherCon []] +T23083.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule3 :: GHC.Types.TrName +[GblId, Unf=OtherCon []] +T23083.$trModule3 = GHC.Types.TrNameS T23083.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule2 :: GHC.Prim.Addr# +[GblId, Unf=OtherCon []] +T23083.$trModule2 = "T23083"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule1 :: GHC.Types.TrName +[GblId, Unf=OtherCon []] +T23083.$trModule1 = GHC.Types.TrNameS T23083.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule :: GHC.Types.Module +[GblId, Unf=OtherCon []] +T23083.$trModule = GHC.Types.Module T23083.$trModule3 T23083.$trModule1 + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) +test('T23083', [ grep_errmsg(r'eta.+::.+Integer') ], compile, ['-O -ddump-prep -dsuppress-uniques -dppr-cols=99999']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0492a3a73e990adb93cc93b19e4f964161a0528f...191b6fd8f03c2cf70823b97a39955f67a83e58e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0492a3a73e990adb93cc93b19e4f964161a0528f...191b6fd8f03c2cf70823b97a39955f67a83e58e1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 15:21:23 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Mon, 13 Mar 2023 11:21:23 -0400 Subject: [Git][ghc/ghc][wip/T23083] CorePrep: Eta expand arguments (#23083) Message-ID: <640f3f733ea43_36ed6c4e190f84500672@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: 62007593 by Sebastian Graf at 2023-03-13T16:21:17+01:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. Fixes #23083. - - - - - 6 changed files: - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - + testsuite/tests/simplCore/should_compile/T23083.hs - + testsuite/tests/simplCore/should_compile/T23083.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -406,7 +406,7 @@ coreToStgExpr expr@(App _ _) -- rep might not be equal to rep2 -> return (StgLit $ LitRubbish TypeLike $ getRuntimeRep (exprType expr)) - _ -> pprPanic "coreToStgExpr - Invalid app head:" (ppr expr) + _ -> pprPanic "coreToStgExpr - Invalid app head:" (ppr app_head $$ ppr expr) where (app_head, args, ticks) = myCollectArgs expr coreToStgExpr expr@(Lam _ _) ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1491,12 +1491,31 @@ cpeArg env dmd arg ; if okCpeArg arg2 then do { v <- newVar arg_ty - ; let arg3 = cpeEtaExpand (exprArity arg2) arg2 + ; let ao = cp_arityOpts (cpe_config env) + -- See Note [Eta expansion of arguments in CorePrep] + ; let arg3 | Just at <- exprEtaExpandArity ao arg2 + , not (is_join_head arg2) + -- See Note [Eta expansion for join points] + -- Eta expanding the join point would + -- introduce crap that we can't generate + -- code for + = cpeEtaExpand (arityTypeArity at) arg2 + | otherwise + = arg2 arg_float = mkFloat env dmd is_unlifted v arg3 ; return (addFloat floats2 arg_float, varToCoreExpr v) } else return (floats2, arg2) } +is_join_head :: CoreExpr -> Bool +-- ^ Identify the cases where our mishandling described in +-- Note [Eta expansion for join points] would generate crap +is_join_head (Let bs e) = isJoinBind bs || is_join_head e +is_join_head (Cast e _) = is_join_head e +is_join_head (Tick _ e) = is_join_head e +is_join_head (Case _ _ _ alts) = any is_join_head (rhssOfAlts alts) +is_join_head _ = False + {- Note [Floating unlifted arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1614,6 +1633,36 @@ and now we do NOT want eta expansion to give Instead GHC.Core.Opt.Arity.etaExpand gives f = /\a -> \y -> let s = h 3 in g s y +Note [Eta expansion of arguments in CorePrep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We eta expand arguments in here, in CorePrep, rather than in the Simplifier, and +do so based on 'exprEtaExpandArity' rather than the cheaper 'exprArity' analysis +we do on let RHSs and lambdas. The reason for the latter is that the Simplifier +has already run the more costly analysis on lambdas and let RHSs and eta +expanded accordingly, while it does not try to eta expand arguments at all. + +So why eta expand arguments in CorePrep rather than in the Simplifier? +There are two reasons why eta expansion of arguments is useful + + 1. In expressions like @f (h `seq` (g $))@ (from T23083) eta expanding the + argument to @f (\x -> h `seq` (g $ x))@ allows us to save allocation of a + closure and have a faster call sequence; a code-gen matter. + + 2. The eta expansion to @f (\x -> h `seq` (g $ x))@ gives rise to another + opportunity: We could inline ($), saving call overhead and perhaps turning + an unknown call into a known call. In general, there could be further + simplification based on the structure of the concrete argument `x`. + Whether we should inline in the PAP `(g $)` (thus solving this problem + independently of (1)) is discussed in #22886. + +To profit from (1), it is enough to eta expand in CorePrep, while (2) shows +that in some rare cases as above, eta expansion of arguments may enable +further simplification. CorePrep would not allow to exploit (2), while eta +expansion in the Simplifier would. + +Alas, trying to eta expand arguments in every round of the Simplifier is costly +(!10088 measured a geom. mean of +2.0% regression in ghc/alloc perf, regressing +as much as 27.2%), so we only exploit (1) for now. -} cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs @@ -1977,6 +2026,9 @@ data CorePrepConfig = CorePrepConfig , cp_convertNumLit :: !(LitNumType -> Integer -> Maybe CoreExpr) -- ^ Convert some numeric literals (Integer, Natural) into their final -- Core form. + + , cp_arityOpts :: !ArityOpts + -- ^ Configuration for arity analysis ('exprEtaExpandArity'). } data CorePrepEnv @@ -1987,6 +2039,7 @@ data CorePrepEnv -- enabled we instead produce an 'error' expression to catch -- the case where a function we think should bottom -- unexpectedly returns. + , cpe_env :: IdEnv CoreExpr -- Clone local Ids -- ^ This environment is used for three operations: -- ===================================== compiler/GHC/Driver/Config/CoreToStg/Prep.hs ===================================== @@ -9,6 +9,7 @@ import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Config.Core.Lint +import GHC.Driver.Config.Core.Opt.Arity import GHC.Tc.Utils.Env import GHC.Types.Var import GHC.Utils.Outputable ( alwaysQualify ) @@ -17,14 +18,16 @@ import GHC.CoreToStg.Prep initCorePrepConfig :: HscEnv -> IO CorePrepConfig initCorePrepConfig hsc_env = do + let dflags = hsc_dflags hsc_env convertNumLit <- do - let platform = targetPlatform $ hsc_dflags hsc_env + let platform = targetPlatform dflags home_unit = hsc_home_unit hsc_env lookup_global = lookupGlobal hsc_env mkConvertNumLiteral platform home_unit lookup_global return $ CorePrepConfig { cp_catchNonexhaustiveCases = gopt Opt_CatchNonexhaustiveCases $ hsc_dflags hsc_env , cp_convertNumLit = convertNumLit + , cp_arityOpts = initArityOpts dflags } initCorePrepPgmConfig :: DynFlags -> [Var] -> CorePrepPgmConfig ===================================== testsuite/tests/simplCore/should_compile/T23083.hs ===================================== @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +module T23083 where + +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +g f h = f (h `seq` (h $)) ===================================== testsuite/tests/simplCore/should_compile/T23083.stderr ===================================== @@ -0,0 +1,42 @@ + +==================== CorePrep ==================== +Result size of CorePrep = {terms: 27, types: 24, coercions: 0, joins: 0/1} + +-- RHS size: {terms: 12, types: 13, coercions: 0, joins: 0/1} +T23083.g :: ((GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer) -> (GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer +[GblId, Arity=2, Str=<1C(1,L)>, Unf=OtherCon []] +T23083.g + = \ (f [Occ=Once1!] :: (GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer) (h [Occ=OnceL1] :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> + let { + sat [Occ=Once1] :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer + [LclId] + sat = \ (eta [Occ=Once1] :: GHC.Num.Integer.Integer) -> case h of h1 [Occ=Once1] { __DEFAULT -> GHC.Base.$ @GHC.Types.LiftedRep @GHC.Num.Integer.Integer @GHC.Num.Integer.Integer h1 eta } } in + f sat + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule4 :: GHC.Prim.Addr# +[GblId, Unf=OtherCon []] +T23083.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule3 :: GHC.Types.TrName +[GblId, Unf=OtherCon []] +T23083.$trModule3 = GHC.Types.TrNameS T23083.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule2 :: GHC.Prim.Addr# +[GblId, Unf=OtherCon []] +T23083.$trModule2 = "T23083"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule1 :: GHC.Types.TrName +[GblId, Unf=OtherCon []] +T23083.$trModule1 = GHC.Types.TrNameS T23083.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule :: GHC.Types.Module +[GblId, Unf=OtherCon []] +T23083.$trModule = GHC.Types.Module T23083.$trModule3 T23083.$trModule1 + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) +test('T23083', [ grep_errmsg(r'eta.+::.+Integer') ], compile, ['-O -ddump-prep -dsuppress-uniques -dppr-cols=99999']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62007593d948d3b4726f5644adf12089724f689e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62007593d948d3b4726f5644adf12089724f689e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 16:26:33 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 13 Mar 2023 12:26:33 -0400 Subject: [Git][ghc/ghc][wip/T22194] 2 commits: Wibbles Message-ID: <640f4eb9a1af2_36ed6c4f5877405039fd@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194 at Glasgow Haskell Compiler / GHC Commits: cf015be3 by Simon Peyton Jones at 2023-03-13T11:00:31+00:00 Wibbles - - - - - 32f9a72a by Simon Peyton Jones at 2023-03-13T16:27:40+00:00 Wibbles - - - - - 3 changed files: - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1539,15 +1539,17 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco then finish_with_swapping else finish_without_swapping } - -- See Note [Always put TyVarLHS on the left] | TyVarLHS {} <- lhs1 , TyFamLHS {} <- lhs2 - = finish_without_swapping + = if put_tyvar_on_lhs + then finish_without_swapping + else finish_with_swapping - -- See Note [Always put TyVarLHS on the left] | TyFamLHS {} <- lhs1 , TyVarLHS {} <- lhs2 - = finish_with_swapping + = if put_tyvar_on_lhs + then finish_with_swapping + else finish_without_swapping | TyFamLHS fun_tc1 fun_args1 <- lhs1 , TyFamLHS fun_tc2 fun_args2 <- lhs2 @@ -1629,10 +1631,15 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco (canEqLHSType lhs1) (canEqLHSType lhs2) mco ; canEqCanLHSFinish new_ev eq_rel IsSwapped lhs2 (ps_xi1 `mkCastTyMCo` sym_mco) } -{- Note [Always put TyVarLHS on the left] + put_tyvar_on_lhs = isWanted ev && eq_rel == NomEq + -- See Note [Orienting TyVarLHS/TyFamLHS] + -- Same conditions as for canEqCanLHSFinish_try_unification + -- which we are setting ourselves up for here + +{- Note [Orienting TyVarLHS/TyFamLHS] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -What if one side is a tyvar and the other is a type family -application, (a ~ F tys) ? Which to put on the left? Answer: +What if one side is a TyVarLHS and the other is a TyFamLHS, (a ~ F tys)? +Which to put on the left? Answer: * Put the tyvar on the left, (a ~ F tys) as this may be our only shot to unify. * But if we fail to unify and end up in cantMakeCanonical, then flip back to (F tys ~ a) because it's generally better @@ -1836,6 +1843,9 @@ Wrinkles: and unifying alpha effectively promotes this wanted to a given. Doing so means we lose track of the rewriter set associated with the wanted. + In short: we must not have a co_hole in a Given, and unification + effectively makes a Given + On the other hand, w is perfectly suitable for rewriting, because of the way we carefully track rewriter sets. ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -166,6 +166,7 @@ import GHC.Types.Name.Reader import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Unique.Supply +import GHC.Types.Unique.Set (nonDetEltsUniqSet) import GHC.Unit.Module ( HasModule, getModule, extractModule ) import qualified GHC.Rename.Env as TcM @@ -189,7 +190,6 @@ import Data.Foldable import qualified Data.Semigroup as S #if defined(DEBUG) -import GHC.Types.Unique.Set (nonDetEltsUniqSet) import GHC.Data.Graph.Directed #endif @@ -2074,23 +2074,23 @@ checkTouchableTyVarEq -- with extra wanteds 'cts' -- If it returns (PuFail reason) we can't unify, and the reason explains why. checkTouchableTyVarEq ev lhs_tv rhs - | MetaTv { mtv_info = lhs_tv_info, mtv_tclvl = lhs_tv_lvl } <- tcTyVarDetails lhs_tv = do { traceTcS "checkTouchableTyVarEq" (ppr lhs_tv $$ ppr rhs) - ; check_result <- wrapTcS (check_rhs lhs_tv_info lhs_tv_lvl) + ; check_result <- wrapTcS check_rhs ; traceTcS "checkTouchableTyVarEq 2" (ppr lhs_tv $$ ppr check_result) ; case check_result of PuFail reason -> return (PuFail reason) PuOK redn cts -> do { emitWork (bagToList cts) ; return (pure redn) } } - - | otherwise = pprPanic "checkTouchableTyVarEq" (ppr lhs_tv) where ghci_tv = isRuntimeUnkSkol lhs_tv - - check_rhs lhs_tv_info lhs_tv_lvl = case coreFullView rhs of - TyConApp tc tys | isTypeFamilyTyCon tc - , not (isConcreteTyVar lhs_tv) - -> -- Special case for lhs ~ F tys + (lhs_tv_info, lhs_tv_lvl) = case tcTyVarDetails lhs_tv of + MetaTv { mtv_info = info, mtv_tclvl = lvl } -> (info,lvl) + _ -> pprPanic "checkTouchableTyVarEq" (ppr lhs_tv) + + check_rhs = case splitTyConApp_maybe rhs of + Just (tc, tys) | isTypeFamilyTyCon tc + , not (isConcreteTyVar lhs_tv) + -> -- Special case for alpha ~ F tys -- We don't want to flatten that (F tys) do { tys_res <- mapCheck (simple_check lhs_tv_lvl) tys ; return (mkTyConAppRedn Nominal tc <$> tys_res) } @@ -2267,31 +2267,47 @@ checkTypeEq ev eq_rel lhs rhs where ghci_tv = False - check_given :: TcType -> TcM (PuResult (TcTyVar,TcType) Reduction) - check_given = case lhs of - TyFamLHS {} -> checkTyEqRhs ghci_tv refl_tv check_given_fam_app refl_co - TyVarLHS tv -> checkTyEqRhs ghci_tv (check_tv tv) check_given_fam_app (check_co tv) - + ---------------------- Wanted ------------------ check_wanted :: TcType -> TcM (PuResult Ct Reduction) check_wanted = case lhs of - TyFamLHS {} -> checkTyEqRhs ghci_tv refl_tv check_wanted_fam_app refl_co - TyVarLHS tv -> checkTyEqRhs ghci_tv (check_tv tv) check_wanted_fam_app (check_co tv) + TyFamLHS tc tys -> checkTyEqRhs ghci_tv refl_tv (cfa_wanted_fam tc tys) refl_co + TyVarLHS tv -> checkTyEqRhs ghci_tv (check_tv tv) cfa_wanted_tv (check_co tv) + + -- Family-application (G tys) in [W] F lhs_tys ~ (...(G tys)...) + cfa_wanted_fam :: TyCon -> [TcType] + -> TcType -> TyCon -> [TcType] + -> TcM (PuResult Ct Reduction) + cfa_wanted_fam lhs_tc lhs_tys fam_app tc tys + | tcEqTyConApps lhs_tc lhs_tys tc tys + = failCheckWith (occursProblem eq_rel) + | otherwise + = recurseFamApp check_wanted fam_app tc tys - check_wanted_fam_app _ tc tys -- Just recurse; if there is an - -- occurs check etc, just fail - = do { tys_res <- mapCheck check_wanted tys - ; return (mkTyConAppRedn Nominal tc <$> tys_res) } + cfa_wanted_tv fam_app tc tys = recurseFamApp check_wanted fam_app tc tys - check_given_fam_app fam_app tc tys + ---------------------- Given ------------------ + check_given :: TcType -> TcM (PuResult (TcTyVar,TcType) Reduction) + check_given = case lhs of + TyFamLHS tc tys -> checkTyEqRhs ghci_tv refl_tv (cfa_given_fam tc tys) refl_co + TyVarLHS tv -> checkTyEqRhs ghci_tv (check_tv tv) cfa_given_tv (check_co tv) + + cfa_given_fam lhs_tc lhs_tys fam_app tc tys + | tcEqTyConApps lhs_tc lhs_tys tc tys + = break_cycle fam_app + | otherwise + = recurseFamApp check_given fam_app tc tys + + cfa_given_tv fam_app tc tys = -- Try just checking the arguments do { tys_res <- mapCheck check_given tys ; case tys_res of { PuOK redns cts -> return (PuOK (mkTyConAppRedn Nominal tc redns) cts) ; - PuFail {} -> + PuFail {} -> break_cycle fam_app } } - do { new_tv <- TcM.newCycleBreakerTyVar (typeKind fam_app) + break_cycle fam_app + = do { new_tv <- TcM.newCycleBreakerTyVar (typeKind fam_app) ; return (PuOK (mkReflRedn Nominal (mkTyVarTy new_tv)) - (unitBag (new_tv, fam_app))) } }} + (unitBag (new_tv, fam_app))) } -- Why reflexive? See Detail (4) of the Note refl_tv tv = okCheckRefl (mkTyVarTy tv) @@ -2318,6 +2334,13 @@ checkTypeEq ev eq_rel lhs rhs cb_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin +recurseFamApp :: (TcType -> TcM (PuResult a Reduction)) + -> TcType -> TyCon -> [TcType] -> TcM (PuResult a Reduction) +-- Just recurse; if there is an occurs check etc, just fail +recurseFamApp check _ tc tys + = do { tys_res <- mapCheck check tys + ; return (mkTyConAppRedn Nominal tc <$> tys_res) } + ------------------------- checkFreeVars :: TcTyVar -> TcLevel -> TyCoVarSet -> TcM CheckTyEqResult -- Check this set of TyCoVars for ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2664,9 +2664,8 @@ occursCheckTv lhs_tv occ_tv uTypeCheckTouchableTyVarEq :: TcTyVar -> TcType -> TcM (PuResult () ()) uTypeCheckTouchableTyVarEq lhs_tv rhs - | MetaTv { mtv_info = tv_info } <- tcTyVarDetails lhs_tv = do { check_result <- checkTyEqRhs False - (simple_check_tv (isConcreteInfo tv_info)) + simple_check_tv dont_flatten (simpleCheckCo lhs_tv True) rhs @@ -2676,15 +2675,17 @@ uTypeCheckTouchableTyVarEq lhs_tv rhs PuOK redn _ -> assertPpr (isReflCo (reductionCoercion redn)) (ppr lhs_tv $$ ppr rhs $$ ppr redn) $ return (PuOK () emptyBag) } - - -- Only called on meta-tyvars - | otherwise = pprPanic "uTypeCHeckTouchableTyVarEq" (ppr lhs_tv) where + lhs_tv_info = case tcTyVarDetails lhs_tv of + MetaTv { mtv_info = tv_info } -> tv_info + _ -> pprPanic "uTypeCheckTouchableTyVarEq" (ppr lhs_tv) + dont_flatten :: TcType -> TyCon -> [TcType] -> TcM (PuResult () Reduction) dont_flatten _ _ _ = failCheckWith (cteProblem cteTypeFamily) -- See Note [Prevent unification with type families] - simple_check_tv lhs_tv_is_concrete occ_tv + lhs_tv_is_concrete = isConcreteInfo lhs_tv_info + simple_check_tv occ_tv | occursCheckTv lhs_tv occ_tv = failCheckWith insolubleOccursProblem | lhs_tv_is_concrete, not (isConcreteTyVar occ_tv) @@ -2710,8 +2711,11 @@ simpleCheckCo lhs_tv unifying co checkTyEqRhs :: forall a. Bool -- RuntimeUnk tyvar on the LHS; accept foralls -> (TcTyVar -> TcM (PuResult a Reduction)) + -- What to do for tyvars -> (TcType -> TyCon -> [TcType] -> TcM (PuResult a Reduction)) + -- What to do for family applications; guaranteed precisely saturated -> (TcCoercion -> TcM (PuResult a TcCoercion)) + -- What to do for coercions -> TcType -> TcM (PuResult a Reduction) checkTyEqRhs ghci_tv check_tv flatten_fam_app check_co rhs @@ -2750,16 +2754,27 @@ checkTyEqRhs ghci_tv check_tv flatten_fam_app check_co rhs go_tc :: TcType -> TyCon -> [TcType] -> TcM (PuResult a Reduction) go_tc ty tc tys | isTypeFamilyTyCon tc - = flatten_fam_app ty tc tys - - | not (isFamFreeTyCon tc) -- e.g. S a where type S a = F [a] + , let arity = tyConArity tc + = if tys `lengthIs` arity + then flatten_fam_app ty tc tys -- Common case + else do { let (fun_args, extra_args) = splitAt (tyConArity tc) tys + fun_app = mkTyConApp tc fun_args + ; fun_res <- flatten_fam_app fun_app tc fun_args + ; extra_res <- mapCheck go extra_args + ; return (mkAppRedns <$> fun_res <*> extra_res) } + + | not (isFamFreeTyCon tc) || isForgetfulSynTyCon tc + -- e.g. S a where type S a = F [a] + -- or type S a = Int + -- ToDo: explain why , Just ty' <- coreView ty -- Only synonyms and type families reply = go ty' -- False to isFamFreeTyCon - | otherwise + | otherwise -- Recurse on arguments = do { tys_res <- mapCheck go tys - ; if | PuFail {} <- tys_res, Just ty' <- coreView ty - -> go ty' -- Expand synonyms on failure + ; if | PuFail {} <- tys_res + , Just ty' <- coreView ty -- Expand synonyms on failure + -> go ty' -- e.g a ~ P a where type P a = Int | not (isTauTyCon tc || ghci_tv) -> failCheckWith impredicativeProblem | otherwise @@ -2778,20 +2793,20 @@ touchabilityTest given_eq_lvl tv rhs = False ------------------------- --- | checkTopShape checks (TYVAR-TV), (COERCION-HOLE) and (CONCRETE) of +-- | checkTopShape checks (TYVAR-TV) -- Note [Unification preconditions]; returns True if these conditions -- are satisfied. But see the Note for other preconditions, too. checkTopShape :: MetaInfo -> TcType -> Bool checkTopShape info xi = case info of - CycleBreakerTv -> False TyVarTv -> - case getTyVar_maybe xi of + case getTyVar_maybe xi of -- Looks through type synonyms Nothing -> False Just tv -> case tcTyVarDetails tv of -- (TYVAR-TV) wrinkle SkolemTv {} -> True RuntimeUnk -> True MetaTv { mtv_info = TyVarTv } -> True _ -> False + CycleBreakerTv -> False -- We never unify these _ -> True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26ce990bef18ba7a9c8af12628085d1fb890e856...32f9a72a8a7efd62122f4f185e4cf76126778eb9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26ce990bef18ba7a9c8af12628085d1fb890e856...32f9a72a8a7efd62122f4f185e4cf76126778eb9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 16:34:20 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 13 Mar 2023 12:34:20 -0400 Subject: [Git][ghc/ghc][wip/t21766] 20 commits: JS: Fix implementation of MK_JSVAL Message-ID: <640f508c7244d_36ed6c4f64ec64506144@gitlab.mail> Finley McIlwaine pushed to branch wip/t21766 at Glasgow Haskell Compiler / GHC Commits: bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - f301fbd7 by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - a7b1c5a3 by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - 58ef56ea by Finley McIlwaine at 2023-03-13T10:33:47-06:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 9547dbd9 by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - e16c7325 by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Add note describing IPE data compression See ticket #21766 - - - - - be264b0b by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 68c57334 by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - 6689c603 by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - ea9e66c0 by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 2a82882c by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Update user's guide and release notes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. See ticket #21766 - - - - - a992f78d by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Fix multiline string in `IPE.c` - - - - - 097edb9f by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Optional static linking of libzstd Allow for libzstd to be statically linked with a `--enable-static-libzstd` configure flag. Not supported on darwin due to incompatibility with `:x.a` linker flags. - - - - - e5094d7f by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Detect darwin for `--enable-static-libzstd` Update users guide to note the optional static linking of libzstd, and update ci-images rev to get libzstd in debian images on CI - - - - - 6b09369c by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Revert `+ipe` enabled CI jobs for ~IPE label - - - - - 491644db by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Use correct image for wasm jobs in CI - - - - - 4db6e54e by Finley McIlwaine at 2023-03-13T10:33:47-06:00 Update DOCKER_REV - - - - - 29 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - m4/fp_find_libnuma.m4 - + m4/fp_find_libzstd.m4 - rts/IPE.c - rts/IPE.h - rts/include/rts/IPE.h - rts/rts.cabal.in - + testsuite/tests/javascript/T23101.hs - + testsuite/tests/javascript/T23101.stdout - + testsuite/tests/javascript/all.T - testsuite/tests/rts/ipe/ipeEventLog_fromMap.c - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c - testsuite/tests/rts/ipe/ipe_lib.h Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 572353e0644044fe3a5465bba4342a9a0b0eb60e + DOCKER_REV: eaab9a340a2e4ab2e63aeda156b58e137b2a5607 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/gen_ci.hs ===================================== @@ -133,30 +133,33 @@ data CrossEmulator -- | A BuildConfig records all the options which can be modified to affect the -- bindists produced by the compiler. data BuildConfig - = BuildConfig { withDwarf :: Bool - , unregisterised :: Bool - , buildFlavour :: BaseFlavour - , bignumBackend :: BignumBackend - , llvmBootstrap :: Bool - , withAssertions :: Bool - , withNuma :: Bool - , crossTarget :: Maybe String - , crossEmulator :: CrossEmulator - , configureWrapper :: Maybe String - , fullyStatic :: Bool - , tablesNextToCode :: Bool - , threadSanitiser :: Bool - , noSplitSections :: Bool + = BuildConfig { withDwarf :: Bool + , unregisterised :: Bool + , buildFlavour :: BaseFlavour + , bignumBackend :: BignumBackend + , llvmBootstrap :: Bool + , withAssertions :: Bool + , withNuma :: Bool + , withZstd :: Bool + , crossTarget :: Maybe String + , crossEmulator :: CrossEmulator + , configureWrapper :: Maybe String + , fullyStatic :: Bool + , tablesNextToCode :: Bool + , threadSanitiser :: Bool + , noSplitSections :: Bool , validateNonmovingGc :: Bool + , isWasm :: Bool } -- Extra arguments to pass to ./configure due to the BuildConfig configureArgsStr :: BuildConfig -> String configureArgsStr bc = unwords $ - ["--enable-unregisterised"| unregisterised bc ] + ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] ++ ["--with-system-libffi" | crossTarget bc == Just "wasm32-wasi" ] + ++ ["--enable-ipe-data-compression" | withZstd bc ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -171,8 +174,12 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts data Flavour = Flavour BaseFlavour [FlavourTrans] -data FlavourTrans - = Llvm | Dwarf | FullyStatic | ThreadSanitiser | NoSplitSections +data FlavourTrans = + Llvm + | Dwarf + | FullyStatic + | ThreadSanitiser + | NoSplitSections | BootNonmovingGc data BaseFlavour = Release | Validate | SlowValidate deriving Eq @@ -191,6 +198,7 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , withZstd = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -199,6 +207,7 @@ vanilla = BuildConfig , threadSanitiser = False , noSplitSections = False , validateNonmovingGc = False + , isWasm = False } splitSectionsBroken :: BuildConfig -> BuildConfig @@ -223,6 +232,10 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } +ipe :: BuildConfig +ipe = vanilla { withZstd = True + } + static :: BuildConfig static = vanilla { fullyStatic = True } @@ -271,10 +284,10 @@ tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use -- These names are used to find the docker image so they have to match what is -- in the docker registry. distroName :: LinuxDistro -> String -distroName Debian11 = "deb11" +distroName Debian11 = "deb11" distroName Debian10 = "deb10" -distroName Debian9 = "deb9" -distroName Fedora33 = "fedora33" +distroName Debian9 = "deb9" +distroName Fedora33 = "fedora33" distroName Ubuntu1804 = "ubuntu18_04" distroName Ubuntu2004 = "ubuntu20_04" distroName Centos7 = "centos7" @@ -283,14 +296,14 @@ distroName Rocky8 = "rocky8" opsysName :: Opsys -> String opsysName (Linux distro) = "linux-" ++ distroName distro -opsysName Darwin = "darwin" +opsysName Darwin = "darwin" opsysName FreeBSD13 = "freebsd13" -opsysName Windows = "windows" +opsysName Windows = "windows" archName :: Arch -> String -archName Amd64 = "x86_64" +archName Amd64 = "x86_64" archName AArch64 = "aarch64" -archName I386 = "i386" +archName I386 = "i386" binDistName :: Arch -> Opsys -> BuildConfig -> String binDistName arch opsys bc = "ghc-" ++ testEnv arch opsys bc @@ -311,22 +324,22 @@ testEnv arch opsys bc = intercalate "-" $ -- | The hadrian flavour string we are going to use for this build flavourString :: Flavour -> String -flavourString (Flavour base trans) = baseString base ++ concatMap (("+" ++) . flavourString) trans +flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . flavour_string) trans where - baseString Release = "release" - baseString Validate = "validate" - baseString SlowValidate = "slow-validate" + base_string Release = "release" + base_string Validate = "validate" + base_string SlowValidate = "slow-validate" - flavourString Llvm = "llvm" - flavourString Dwarf = "debug_info" - flavourString FullyStatic = "fully_static" - flavourString ThreadSanitiser = "thread_sanitizer" - flavourString NoSplitSections = "no_split_sections" - flavourString BootNonmovingGc = "boot_nonmoving_gc" + flavour_string Llvm = "llvm" + flavour_string Dwarf = "debug_info" + flavour_string FullyStatic = "fully_static" + flavour_string ThreadSanitiser = "thread_sanitizer" + flavour_string NoSplitSections = "no_split_sections" + flavour_string BootNonmovingGc = "boot_nonmoving_gc" -- The path to the docker image (just for linux builders) -dockerImage :: Arch -> Opsys -> Maybe String -dockerImage arch (Linux distro) = +dockerImage :: Arch -> Opsys -> Bool -> Maybe String +dockerImage arch (Linux distro) isWasm = Just image where image = mconcat @@ -334,9 +347,10 @@ dockerImage arch (Linux distro) = , archName arch , "-linux-" , distroName distro + , if isWasm then "-wasm" else "" , ":$DOCKER_REV" ] -dockerImage _ _ = Nothing +dockerImage _ _ _ = Nothing ----------------------------------------------------------------------------- -- Platform specific variables @@ -515,7 +529,7 @@ manualRule rules = rules { when = Manual } -- For example, even if you don't explicitly disable a rule it will end up in the -- rule list with the OFF state. enumRules :: OnOffRules -> [OnOffRule] -enumRules o = map lkup rules +enumRules o = map lkup rulesList where enabled_rules = rule_set o lkup r = OnOffRule (if S.member r enabled_rules then On else Off) r @@ -551,6 +565,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. | NonmovingGc -- ^ Only run this job when the "non-moving GC" label is set. + | IpeData -- ^ Only run this job when the "IPE" label is set | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -577,12 +592,14 @@ ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" ruleString Off Nightly = "$NIGHTLY == null" +ruleString On IpeData = "$CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/" +ruleString Off IpeData = true ruleString On Disable = false ruleString Off Disable = true -- Enumeration of all the rules -rules :: [Rule] -rules = [minBound .. maxBound] +rulesList :: [Rule] +rulesList = [minBound .. maxBound] -- | A 'Job' is the description of a single job in a gitlab pipeline. The -- job contains all the information about how to do the build but can be further @@ -636,7 +653,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } jobTags = tags arch opsys buildConfig - jobDockerImage = dockerImage arch opsys + jobDockerImage = dockerImage arch opsys (isWasm buildConfig) jobScript | Windows <- opsys @@ -872,11 +889,12 @@ job_groups = , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure (modifyValidateJobs manual tsan_jobs) + , disableValidate (validateBuilds Amd64 (Linux Debian10) ipe) , -- Nightly allowed to fail: #22343 modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - + , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) ipe) , disableValidate (standardBuilds Amd64 (Linux Debian11)) -- We still build Deb9 bindists for now due to Ubuntu 18 and Linux Mint 19 -- not being at EOL until April 2023 and they still need tinfo5. @@ -935,7 +953,8 @@ job_groups = (crossConfig "wasm32-wasi" NoEmulatorNeeded Nothing) { fullyStatic = True - , buildFlavour = Release -- TODO: This needs to be validate but wasm backend doesn't pass yet + , buildFlavour = Release -- TODO: This needs to be validate but wasm backend doesn't pass yet + , isWasm = True } ===================================== .gitlab/jobs.yaml ===================================== @@ -35,7 +35,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -97,7 +97,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -155,7 +155,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -213,7 +213,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -276,7 +276,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -335,7 +335,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -394,7 +394,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -453,7 +453,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -518,7 +518,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -570,7 +570,7 @@ ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12-wasm:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -579,7 +579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -631,7 +631,7 @@ ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12-wasm:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -640,7 +640,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -701,7 +701,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -755,7 +755,7 @@ ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12-wasm:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -764,7 +764,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -825,7 +825,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -888,7 +888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -948,7 +948,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1007,7 +1007,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1066,7 +1066,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1126,7 +1126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1185,7 +1185,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1204,7 +1204,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1244,7 +1244,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1303,7 +1303,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1362,7 +1362,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1423,7 +1423,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1484,7 +1484,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1546,7 +1546,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1605,7 +1605,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1665,7 +1665,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1724,7 +1724,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1785,7 +1785,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1847,7 +1847,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1908,7 +1908,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1968,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2027,7 +2027,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2082,7 +2082,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2141,7 +2141,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2204,7 +2204,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2268,7 +2268,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2328,7 +2328,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2388,7 +2388,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2454,7 +2454,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2518,7 +2518,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2582,7 +2582,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2643,7 +2643,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2703,7 +2703,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2763,7 +2763,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2823,7 +2823,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2884,7 +2884,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2944,7 +2944,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3006,7 +3006,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3068,7 +3068,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3131,7 +3131,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3192,7 +3192,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3252,7 +3252,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3308,7 +3308,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3368,7 +3368,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3432,7 +3432,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3496,7 +3496,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3547,7 +3547,7 @@ ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12-wasm:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -3556,7 +3556,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3616,7 +3616,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3678,7 +3678,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3737,7 +3737,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3795,7 +3795,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3854,7 +3854,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3877,6 +3877,64 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, + "x86_64-linux-deb10-validate": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "2 weeks", + "paths": [ + "ghc-x86_64-linux-deb10-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb10-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "TEST_ENV": "x86_64-linux-deb10-validate" + } + }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3912,7 +3970,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3970,7 +4028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4029,7 +4087,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4089,7 +4147,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4149,7 +4207,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4210,7 +4268,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4269,7 +4327,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4325,7 +4383,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -553,7 +553,7 @@ countArgs _ = 0 countValArgs :: SimplCont -> Int -- Count value arguments only -countValArgs (ApplyToTy { sc_cont = cont }) = 1 + countValArgs cont +countValArgs (ApplyToTy { sc_cont = cont }) = countValArgs cont countValArgs (ApplyToVal { sc_cont = cont }) = 1 + countValArgs cont countValArgs (CastIt _ cont) = countValArgs cont countValArgs _ = 0 @@ -1859,11 +1859,12 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpandRhs env bind_cxt bndr rhs - | do_eta_expand -- If the current manifest arity isn't enough - -- (never true for join points) - , seEtaExpand env -- and eta-expansion is on - , wantEtaExpansion rhs - = -- Do eta-expansion. + | seEtaExpand env -- If Eta-expansion is on + , wantEtaExpansion rhs -- and we'd like to eta-expand e + , do_eta_expand -- and e's manifest arity is lower than + -- what it could be + -- (never true for join points) + = -- Do eta-expansion. assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ -- assert: this never happens for join points; see GHC.Core.Opt.Arity -- Note [Do not eta-expand join points] ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -639,7 +639,7 @@ jsResultWrapper result_ty | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey = do -- result_id <- newSysLocalDs boolTy ccall_uniq <- newUnique - let forceBool e = mkJsCall ccall_uniq (fsLit "$r = !(!$1)") [e] boolTy + let forceBool e = mkJsCall ccall_uniq (fsLit "((x) => { return !(!x); })") [e] boolTy return (Just intPrimTy, \e -> forceBool e) ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,66 +1,187 @@ +{-# LANGUAGE CPP #-} + module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where +import Foreign + +#if defined(HAVE_LIBZSTD) +import Foreign.C.Types +import qualified Data.ByteString.Internal as BSI +import GHC.IO (unsafePerformIO) +#endif + +import GHC.Data.FastString (fastStringToShortText) import GHC.Prelude import GHC.Platform +import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) import GHC.Unit.Module import GHC.Utils.Outputable -import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile) -import GHC.Data.FastString (fastStringToShortText) +import GHC.Cmm import GHC.Cmm.CLabel -import GHC.Cmm.Expr import GHC.Cmm.Utils import GHC.StgToCmm.Config -import GHC.StgToCmm.Lit (newByteStringCLit) import GHC.StgToCmm.Monad -import GHC.StgToCmm.Utils import GHC.Data.ShortText (ShortText) import qualified GHC.Data.ShortText as ST -import qualified Data.Map.Strict as M import Control.Monad.Trans.State.Strict + import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Lazy as BSL +import qualified Data.Map.Strict as M + +{- +Note [Compression and Decompression of IPE data] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Compiling with `-finfo-table-map` causes build results to include a map from +info tables to source positions called the info table provenance entry (IPE) +map. See Note [Mapping Info Tables to Source Positions]. The IPE information +can grow the size of build results significantly. At the time of writing, a +default build of GHC results in a total of 109M of libHSghc-*.so build results. +A default+ipe build of GHC (see ./hadrian/doc/flavours.md) results in 262M of +libHSghc-*.so build results without compression. -emitIpeBufferListNode :: Module - -> [InfoProvEnt] - -> FCode () +We reduce the impact of IPE data on the size of build results by compressing +the data before it is emitted using the zstd compression library. See +Note [The Info Table Provenance Entry (IPE) Map] for information on the layout +of IPE data on disk and in the RTS. We cannot simply compress all data held in +the IPE entry buffer, as the pointers to info tables must be converted to +memory addresses during linking. Therefore, we can only compress the strings +table and the IPE entries themselves (which essentially only consist of indices +into the strings table). + +With compression, a default+ipe build of GHC results in a total of 205M of +libHSghc-*.so build results. This is over a 20% reduction from the uncompressed +case. + +Decompression happens lazily, as it only occurs when the IPE map is +constructed (which is also done lazily on first lookup or traversal). During +construction, the 'compressed' field of each IPE buffer list node is examined. +If the field indicates that the data has been compressed, the entry data and +strings table are decompressed before continuing with the normal IPE map +construction. +-} + +emitIpeBufferListNode :: + Module + -> [InfoProvEnt] + -> FCode () emitIpeBufferListNode _ [] = return () emitIpeBufferListNode this_mod ents = do cfg <- getStgToCmmConfig - let ctx = stgToCmmContext cfg + + tables_lbl <- mkStringLitLabel <$> newUnique + strings_lbl <- mkStringLitLabel <$> newUnique + entries_lbl <- mkStringLitLabel <$> newUnique + + let ctx = stgToCmmContext cfg platform = stgToCmmPlatform cfg + int n = mkIntCLit platform n + + (cg_ipes, strtab) = flip runState emptyStringTable $ do + module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod) + mapM (toCgIPE platform ctx module_name) ents + + tables :: [CmmStatic] + tables = map (CmmStaticLit . CmmLabel . ipeInfoTablePtr) cg_ipes + + uncompressed_strings :: BS.ByteString + uncompressed_strings = getStringTableStrings strtab + + strings_bytes :: BS.ByteString + strings_bytes = compress defaultCompressionLevel uncompressed_strings + + strings :: [CmmStatic] + strings = [CmmString strings_bytes] + + uncompressed_entries :: BS.ByteString + uncompressed_entries = toIpeBufferEntries (platformByteOrder platform) cg_ipes - let (cg_ipes, strtab) = flip runState emptyStringTable $ do - module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod) - mapM (toCgIPE platform ctx module_name) ents - - let -- Emit the fields of an IpeBufferEntry struct. - toIpeBufferEntry :: CgInfoProvEnt -> [CmmLit] - toIpeBufferEntry cg_ipe = - [ CmmLabel (ipeInfoTablePtr cg_ipe) - , strtab_offset (ipeTableName cg_ipe) - , strtab_offset (ipeClosureDesc cg_ipe) - , strtab_offset (ipeTypeDesc cg_ipe) - , strtab_offset (ipeLabel cg_ipe) - , strtab_offset (ipeModuleName cg_ipe) - , strtab_offset (ipeSrcFile cg_ipe) - , strtab_offset (ipeSrcSpan cg_ipe) - , int32 0 - ] - - int n = mkIntCLit platform n - int32 n = CmmInt n W32 - strtab_offset (StrTabOffset n) = int32 (fromIntegral n) - - strings <- newByteStringCLit (getStringTableStrings strtab) - let lits = [ zeroCLit platform -- 'next' field - , strings -- 'strings' field - , int $ length cg_ipes -- 'count' field - ] ++ concatMap toIpeBufferEntry cg_ipes - emitDataLits (mkIPELabel this_mod) lits + entries_bytes :: BS.ByteString + entries_bytes = compress defaultCompressionLevel uncompressed_entries + + entries :: [CmmStatic] + entries = [CmmString entries_bytes] + + ipe_buffer_lbl :: CLabel + ipe_buffer_lbl = mkIPELabel this_mod + + ipe_buffer_node :: [CmmStatic] + ipe_buffer_node = map CmmStaticLit + [ -- 'next' field + zeroCLit platform + + -- 'compressed' field + , int do_compress + + -- 'count' field + , int $ length cg_ipes + + -- 'tables' field + , CmmLabel tables_lbl + + -- 'entries' field + , CmmLabel entries_lbl + + -- 'entries_size' field (decompressed size) + , int $ BS.length uncompressed_entries + + -- 'string_table' field + , CmmLabel strings_lbl + + -- 'string_table_size' field (decompressed size) + , int $ BS.length uncompressed_strings + ] + + -- Emit the list of info table pointers + emitDecl $ CmmData + (Section Data tables_lbl) + (CmmStaticsRaw tables_lbl tables) + + -- Emit the strings table + emitDecl $ CmmData + (Section Data strings_lbl) + (CmmStaticsRaw strings_lbl strings) + + -- Emit the list of IPE buffer entries + emitDecl $ CmmData + (Section Data entries_lbl) + (CmmStaticsRaw entries_lbl entries) + + -- Emit the IPE buffer list node + emitDecl $ CmmData + (Section Data ipe_buffer_lbl) + (CmmStaticsRaw ipe_buffer_lbl ipe_buffer_node) + +-- | Emit the fields of an IpeBufferEntry struct for each entry in a given list. +toIpeBufferEntries :: + ByteOrder -- ^ Byte order to write the data in + -> [CgInfoProvEnt] -- ^ List of IPE buffer entries + -> BS.ByteString +toIpeBufferEntries byte_order cg_ipes = + BSL.toStrict . BSB.toLazyByteString . mconcat + $ map (mconcat . map word32Builder . to_ipe_buf_ent) cg_ipes + where + to_ipe_buf_ent :: CgInfoProvEnt -> [Word32] + to_ipe_buf_ent cg_ipe = + [ ipeTableName cg_ipe + , ipeClosureDesc cg_ipe + , ipeTypeDesc cg_ipe + , ipeLabel cg_ipe + , ipeModuleName cg_ipe + , ipeSrcFile cg_ipe + , ipeSrcSpan cg_ipe + , 0 -- padding + ] + + word32Builder :: Word32 -> BSB.Builder + word32Builder = case byte_order of + BigEndian -> BSB.word32BE + LittleEndian -> BSB.word32LE toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt toCgIPE platform ctx module_name ipe = do @@ -76,7 +197,7 @@ toCgIPE platform ctx module_name ipe = do coords = renderWithContext ctx (pprUserRealSpan False span) in (file, coords) label <- lookupStringTable $ ST.pack label_str - src_file <- lookupStringTable $ src_loc_file + src_file <- lookupStringTable src_loc_file src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name @@ -104,7 +225,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -newtype StrTabOffset = StrTabOffset Int +type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = @@ -129,9 +250,50 @@ lookupStringTable str = state $ \st -> , stLength = stLength st + ST.byteLength str + 1 , stLookup = M.insert str res (stLookup st) } - res = StrTabOffset (stLength st) + res = fromIntegral (stLength st) in (res, st') +do_compress :: Int +compress :: Int -> BS.ByteString -> BS.ByteString +#if !defined(HAVE_LIBZSTD) +do_compress = 0 +compress _ bs = bs +#else +do_compress = 1 + +compress clvl (BSI.PS srcForeignPtr off len) = unsafePerformIO $ + withForeignPtr srcForeignPtr $ \srcPtr -> do + maxCompressedSize <- zstd_compress_bound $ fromIntegral len + dstForeignPtr <- BSI.mallocByteString (fromIntegral maxCompressedSize) + withForeignPtr dstForeignPtr $ \dstPtr -> do + compressedSize <- fromIntegral <$> + zstd_compress + dstPtr + maxCompressedSize + (srcPtr `plusPtr` off) + (fromIntegral len) + (fromIntegral clvl) + BSI.create compressedSize $ \p -> BSI.memcpy p dstPtr compressedSize + +foreign import ccall unsafe "ZSTD_compress" + zstd_compress :: + Ptr dst -- ^ Destination buffer + -> CSize -- ^ Capacity of destination buffer + -> Ptr src -- ^ Source buffer + -> CSize -- ^ Size of source buffer + -> CInt -- ^ Compression level + -> IO CSize + +-- | Compute the maximum compressed size for a given source buffer size +foreign import ccall unsafe "ZSTD_compressBound" + zstd_compress_bound :: + CSize -- ^ Size of source buffer + -> IO CSize +#endif + +defaultCompressionLevel :: Int +defaultCompressionLevel = 3 + newtype DList a = DList ([a] -> [a]) emptyDList :: DList a ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -115,8 +115,8 @@ genCommonCppDefs profiling = mconcat -- GHCJS.Prim.JSVal , if profiling - then "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)\n" - else "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x))\n" + then "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM))\n" + else "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x)))\n" , "#define JSVAL_VAL(x) ((x).d1)\n" -- GHCJS.Prim.JSException ===================================== compiler/ghc.cabal.in ===================================== @@ -57,6 +57,14 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +Flag with-libzstd + Default: False + Manual: True + +Flag static-libzstd + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -71,6 +79,16 @@ Library if flag(build-tool-depends) build-tool-depends: alex:alex >= 3.2.6, happy:happy >= 1.20.0, genprimopcode:genprimopcode, deriveConstants:deriveConstants + if flag(with-libzstd) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + extra-libraries: zstd + CPP-Options: -DHAVE_LIBZSTD + Build-Depends: base >= 4.11 && < 4.19, deepseq >= 1.4 && < 1.5, directory >= 1 && < 1.4, ===================================== configure.ac ===================================== @@ -1124,6 +1124,10 @@ AC_DEFINE_UNQUOTED([RTS_LINKER_USE_MMAP], [$RtsLinkerUseMmap], GHC_ADJUSTORS_METHOD([Target]) AC_SUBST([UseLibffiForAdjustors]) +dnl ** IPE data compression +dnl -------------------------------------------------------------- +FP_FIND_LIBZSTD + dnl ** Other RTS features dnl -------------------------------------------------------------- FP_FIND_LIBDW @@ -1269,6 +1273,19 @@ echo "\ makeinfo : $MAKEINFO git : $GIT cabal-install : $CABAL +" + +USING_LIBNUMA=$(if [ "$HaveLibNuma" = "1" ]; then echo "YES"; else echo "NO"; fi;) +USING_LIBZSTD=$(if [ "$HaveLibZstd" = "1" ]; then echo "YES"; else echo "NO"; fi;) +STATIC_LIBZSTD=$(if [ "$StaticLibZstd" = "1" ]; then echo "YES"; else echo "NO"; fi;) +USING_LIBDW=$(if [ "$USE_LIBDW" = "1" ]; then echo "YES"; else echo "NO"; fi;) + +echo "\ + Using optional dependencies: + libnuma : $USING_LIBNUMA + libzstd : $USING_LIBZSTD + statically linked? : $STATIC_LIBZSTD + libdw : $USING_LIBDW Using LLVM tools clang : $ClangCmd ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -26,6 +26,20 @@ Compiler has been implemented, allowing ``{..}`` syntax for constructors without fields, for consistency. This is convenient for TH code generation, as you can now uniformly use record wildcards regardless of number of fields. +- The compiler may now be configured to compress the debugging information + included in :ghc-flag:`-finfo-table-map` enabled binaries. To do so, one must + build GHC from source (see + `here` for directions) + and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` + script. **Note**: This feature requires that the machine building GHC has + `libzstd `_ installed. The compression + library `libzstd` may optionally be statically linked in the resulting + compiler (on non-darwin machines) using the `--enable-static-libzstd` + configure flag. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. + - Incoherent instance applications are no longer specialised. The previous implementation of specialisation resulted in nondeterministic instance resolution in certain cases, breaking ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,9 +370,26 @@ to a source location. This lookup table is generated by using the ``-finfo-table also want more precise information about constructor info tables then you should also use :ghc-flag:`-fdistinct-constructor-tables`. - This flag will increase the binary size by quite a lot, depending on how - big your project is. For compiling a project the size of GHC the overhead was - about 200 megabytes. + The :ghc-flag:`-finfo-table-map` flag will increase the binary size by quite + a lot, depending on how big your project is. For compiling a project the + size of GHC the overhead was about 200 megabytes. + + :since: 9.8 + + If you wish to reduce the size of :ghc-flag:`-finfo-table-map` enabled + binaries, consider building GHC from source and supplying the + ``--enable-ipe-data-compression`` flag to the ``configure`` script. This + will cause GHC to compress the :ghc-flag:`-finfo-table-map` related + debugging information included in binaries using the + `libzstd `_ compression library. + **Note**: This feature requires that the machine building GHC has + `libzstd `_ installed. The compression + library ``libzstd`` may optionally be statically linked in the resulting + compiler (on non-darwin machines) using the ``--enable-static-libzstd`` + configure flag. + + In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` + enabled build results was reduced by over 20% when compression was enabled. .. ghc-flag:: -fdistinct-constructor-tables :shortdesc: Generate a fresh info table for each usage ===================================== hadrian/cfg/system.config.in ===================================== @@ -201,10 +201,15 @@ libdw-lib-dir = @LibdwLibDir@ libnuma-include-dir = @LibNumaIncludeDir@ libnuma-lib-dir = @LibNumaLibDir@ +libzstd-include-dir = @LibZstdIncludeDir@ +libzstd-lib-dir = @LibZstdLibDir@ + # Optional Dependencies: #======================= use-lib-dw = @UseLibdw@ +use-lib-zstd = @UseLibZstd@ +static-lib-zstd = @UseStaticLibZstd@ use-lib-numa = @UseLibNuma@ use-lib-m = @UseLibm@ use-lib-rt = @UseLibrt@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -35,6 +35,8 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma + | UseLibzstd + | StaticLibzstd | UseLibm | UseLibrt | UseLibdl @@ -65,6 +67,8 @@ flag f = do UseLibffiForAdjustors -> "use-libffi-for-adjustors" UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" + UseLibzstd -> "use-lib-zstd" + StaticLibzstd -> "static-lib-zstd" UseLibm -> "use-lib-m" UseLibrt -> "use-lib-rt" UseLibdl -> "use-lib-dl" ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -60,6 +60,8 @@ data Setting = BuildArch | LibdwLibDir | LibnumaIncludeDir | LibnumaLibDir + | LibZstdIncludeDir + | LibZstdLibDir | LlvmTarget | ProjectGitCommitId | ProjectName @@ -162,6 +164,8 @@ setting key = lookupSystemConfig $ case key of LibdwLibDir -> "libdw-lib-dir" LibnumaIncludeDir -> "libnuma-include-dir" LibnumaLibDir -> "libnuma-lib-dir" + LibZstdIncludeDir -> "libzstd-include-dir" + LibZstdLibDir -> "libzstd-lib-dir" LlvmTarget -> "llvm-target" ProjectGitCommitId -> "project-git-commit-id" ProjectName -> "project-name" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -291,6 +291,8 @@ rtsCabalFlags = mconcat , flag "CabalNeedLibpthread" UseLibpthread , flag "CabalHaveLibbfd" UseLibbfd , flag "CabalHaveLibNuma" UseLibnuma + , flag "CabalHaveLibZstd" UseLibzstd + , flag "CabalStaticLibZstd" StaticLibzstd , flag "CabalNeedLibatomic" NeedLibatomic , flag "CabalUseSystemLibFFI" UseSystemFfi , flag "CabalLibffiAdjustors" UseLibffiForAdjustors ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -74,6 +74,8 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + , flag UseLibzstd `cabalFlag` "with-libzstd" + , flag StaticLibzstd `cabalFlag` "static-libzstd" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] @@ -283,6 +285,8 @@ rtsPackageArgs = package rts ? do libdwLibraryDir <- getSetting LibdwLibDir libnumaIncludeDir <- getSetting LibnumaIncludeDir libnumaLibraryDir <- getSetting LibnumaLibDir + libzstdIncludeDir <- getSetting LibZstdIncludeDir + libzstdLibraryDir <- getSetting LibZstdLibDir -- Arguments passed to GHC when compiling C and .cmm sources. let ghcArgs = mconcat @@ -389,6 +393,7 @@ rtsPackageArgs = package rts ? do , builder (Cabal Setup) ? mconcat [ cabalExtraDirs libdwIncludeDir libdwLibraryDir , cabalExtraDirs libnumaIncludeDir libnumaLibraryDir + , cabalExtraDirs libzstdIncludeDir libzstdLibraryDir , useSystemFfi ? cabalExtraDirs ffiIncludeDir ffiLibraryDir ] , builder (Cc (FindCDependencies CDep)) ? cArgs ===================================== m4/fp_find_libnuma.m4 ===================================== @@ -30,7 +30,7 @@ AC_DEFUN([FP_FIND_LIBNUMA], [Enable NUMA memory policy and thread affinity support in the runtime system via numactl's libnuma [default=auto]])]) - if test "$enable_numa" != "no" ; then + if test "$enable_numa" = "yes" ; then CFLAGS2="$CFLAGS" CFLAGS="$LIBNUMA_CFLAGS $CFLAGS" LDFLAGS2="$LDFLAGS" @@ -41,7 +41,7 @@ AC_DEFUN([FP_FIND_LIBNUMA], if test "$ac_cv_header_numa_h$ac_cv_header_numaif_h" = "yesyes" ; then AC_CHECK_LIB(numa, numa_available,HaveLibNuma=1) fi - if test "$enable_numa:$HaveLibNuma" = "yes:0" ; then + if test "$HaveLibNuma" = "0" ; then AC_MSG_ERROR([Cannot find system libnuma (required by --enable-numa)]) fi ===================================== m4/fp_find_libzstd.m4 ===================================== @@ -0,0 +1,108 @@ +AC_DEFUN([FP_FIND_LIBZSTD], +[ + dnl ** Is IPE data compression enabled? + dnl -------------------------------------------------------------- + AC_ARG_ENABLE( + ipe-data-compression, + [AS_HELP_STRING( + [--enable-ipe-data-compression], + [Enable compression of info table provenance entries using the + zstd compression library [default=no]] + )], + [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableIpeDataCompression])], + [EnableIpeDataCompression=NO] + ) + + StaticLibZstd=0 + AC_ARG_ENABLE( + static-libzstd, + [AS_HELP_STRING( + [--enable-static-libzstd], + [Statically link the libzstd compression library with the compiler + (not compatible with darwin) [default=no]] + )], + [StaticLibZstd=1], + [StaticLibZstd=0] + ) + + HaveLibZstd=0 + if test "$EnableIpeDataCompression" = "YES"; then + dnl ** Have zstd? + dnl -------------------------------------------------------------- + AC_ARG_WITH( + libzstd-libraries, + [AS_HELP_STRING( + [--with-libzstd-libraries=ARG], + [Find libraries for libzstd in ARG [default=system default]] + )], + [ + LibZstdLibDir="$withval" + LIBZSTD_LDFLAGS="-L$withval" + ] + ) + + AC_SUBST(LibZstdLibDir) + + AC_ARG_WITH( + libzstd-includes, + [AS_HELP_STRING( + [--with-libzstd-includes=ARG], + [Find includes for libzstd in ARG [default=system default]] + )], + [ + LibZstdIncludeDir="$withval" + LIBZSTD_CFLAGS="-I$withval" + ] + ) + + AC_SUBST(LibZstdIncludeDir) + + CFLAGS2="$CFLAGS" + CFLAGS="$LIBZSTD_CFLAGS $CFLAGS" + LDFLAGS2="$LDFLAGS" + LDFLAGS="$LIBZSTD_LDFLAGS $LDFLAGS" + + AC_CHECK_HEADERS([zstd.h]) + + if test "$ac_cv_header_zstd_h" = "yes" ; then + AC_CHECK_LIB(zstd,ZSTD_versionString,HaveLibZstd=1) + fi + if test "$HaveLibZstd" = "0" ; then + AC_MSG_ERROR( + [Cannot find system libzstd (required by + --enable-ipe-data-compression)] + ) + fi + + CFLAGS="$CFLAGS2" + LDFLAGS="$LDFLAGS2" + fi + + AC_DEFINE_UNQUOTED([HAVE_LIBZSTD], [$HaveLibZstd], [Define to 1 if you + wish to compress IPE data in compiler results (requires libzstd)]) + + AC_DEFINE_UNQUOTED([STATIC_LIBZSTD], [$StaticLibZstd], [Define to 1 if you + wish to statically link the libzstd compression library in the compiler + (requires libzstd)]) + + if test $HaveLibZstd = "1" ; then + AC_SUBST([UseLibZstd],[YES]) + AC_SUBST([CabalHaveLibZstd],[True]) + if test $StaticLibZstd = "1" ; then + case "${host_os}" in + darwin*) + AC_MSG_ERROR( + [--enable-static-libzstd is not compatible with darwin] + ) + esac + AC_SUBST([UseStaticLibZstd],[YES]) + AC_SUBST([CabalStaticLibZstd],[True]) + else + AC_SUBST([UseStaticLibZstd],[NO]) + AC_SUBST([CabalStaticLibZstd],[False]) + fi + else + AC_SUBST([UseLibZstd],[NO]) + AC_SUBST([CabalHaveLibZstd],[False]) + fi +]) ===================================== rts/IPE.c ===================================== @@ -20,6 +20,10 @@ #include #include +#if HAVE_LIBZSTD == 1 +#include +#endif + #if defined(TRACING) #include "Trace.h" #endif @@ -36,8 +40,9 @@ collecting IPE lists on registration. It's a singly linked list of IPE list buffers (IpeBufferListNode). These are emitted by the code generator, with generally one produced per module. Each -contains an array of IPE entries and a link field (which is used to link -buffers onto the pending list. +contains a pointer to a list of IPE entries, a pointer to a list of info +table pointers, and a link field (which is used to link buffers onto the +pending list. For reasons of space efficiency, IPE entries are represented slightly differently in the object file than the InfoProvEnt which we ultimately expose @@ -77,23 +82,23 @@ void exitIpe(void) { } #endif // THREADED_RTS -static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, const IpeBufferEntry *ent) +static InfoProvEnt ipeBufferEntryToIpe(const char *strings, const StgInfoTable *tbl, const IpeBufferEntry ent) { - const char *strings = node->string_table; return (InfoProvEnt) { - .info = ent->info, + .info = tbl, .prov = { - .table_name = &strings[ent->table_name], - .closure_desc = &strings[ent->closure_desc], - .ty_desc = &strings[ent->ty_desc], - .label = &strings[ent->label], - .module = &strings[ent->module_name], - .src_file = &strings[ent->src_file], - .src_span = &strings[ent->src_span] + .table_name = &strings[ent.table_name], + .closure_desc = &strings[ent.closure_desc], + .ty_desc = &strings[ent.ty_desc], + .label = &strings[ent.label], + .module = &strings[ent.module_name], + .src_file = &strings[ent.src_file], + .src_span = &strings[ent.src_span] } }; } + #if defined(TRACING) static void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, const void *value) { @@ -105,8 +110,18 @@ void dumpIPEToEventLog(void) { // Dump pending entries IpeBufferListNode *cursor = RELAXED_LOAD(&ipeBufferList); while (cursor != NULL) { + IpeBufferEntry *entries; + char *strings; + + // Decompress if compressed + decompressIPEBufferListNodeIfCompressed(cursor, &entries, &strings); + for (uint32_t i = 0; i < cursor->count; i++) { - const InfoProvEnt ent = ipeBufferEntryToIpe(cursor, &cursor->entries[i]); + const InfoProvEnt ent = ipeBufferEntryToIpe( + strings, + cursor->tables[i], + entries[i] + ); traceIPE(&ent); } cursor = cursor->next; @@ -120,6 +135,7 @@ void dumpIPEToEventLog(void) { RELEASE_LOCK(&ipeMapLock); } + #else void dumpIPEToEventLog(void) { } @@ -169,16 +185,85 @@ void updateIpeMap() { } while (pending != NULL) { - IpeBufferListNode *currentNode = pending; - InfoProvEnt *ip_ents = stgMallocBytes(sizeof(InfoProvEnt) * currentNode->count, "updateIpeMap"); - for (uint32_t i = 0; i < currentNode->count; i++) { - const IpeBufferEntry *ent = ¤tNode->entries[i]; - ip_ents[i] = ipeBufferEntryToIpe(currentNode, ent); - insertHashTable(ipeMap, (StgWord) ent->info, &ip_ents[i]); + IpeBufferListNode *current_node = pending; + const IpeBufferEntry *entries; + const char *strings; + + // Decompress if compressed + decompressIPEBufferListNodeIfCompressed(current_node, &entries, &strings); + + // Convert the on-disk IPE buffer entry representation (IpeBufferEntry) + // into the runtime representation (InfoProvEnt) + InfoProvEnt *ip_ents = stgMallocBytes( + sizeof(InfoProvEnt) * current_node->count, + "updateIpeMap: ip_ents" + ); + for (uint32_t i = 0; i < current_node->count; i++) { + const IpeBufferEntry ent = entries[i]; + const StgInfoTable *tbl = current_node->tables[i]; + ip_ents[i] = ipeBufferEntryToIpe(strings, tbl, ent); + insertHashTable(ipeMap, (StgWord) tbl, &ip_ents[i]); } - pending = currentNode->next; + pending = current_node->next; } RELEASE_LOCK(&ipeMapLock); } + +/* Decompress the IPE data and strings table referenced by an IPE buffer list +node if it is compressed. No matter whether the data is compressed, the pointers +referenced by the 'entries_dst' and 'string_table_dst' parameters will point at +the decompressed IPE data and string table for the given node, respectively, +upon return from this function. +*/ +void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode *node, IpeBufferEntry **entries_dst, char **string_table_dst) { + if (node->compressed) { + // The IPE list buffer node indicates that the strings table and + // entries list has been compressed. If zstd is not available, fail. + // If zstd is available, decompress. +#if HAVE_LIBZSTD == 0 + barf("An IPE buffer list node has been compressed, but the " + "decompression library (zstd) is not available." +); +#else + size_t compressed_sz = ZSTD_findFrameCompressedSize( + node->string_table, + node->string_table_size + ); + char *decompressed_strings = stgMallocBytes( + node->string_table_size, + "updateIpeMap: decompressed_strings" + ); + ZSTD_decompress( + decompressed_strings, + node->string_table_size, + node->string_table, + compressed_sz + ); + *string_table_dst = decompressed_strings; + + // Decompress the IPE data + compressed_sz = ZSTD_findFrameCompressedSize( + node->entries, + node->entries_size + ); + void *decompressed_entries = stgMallocBytes( + node->entries_size, + "updateIpeMap: decompressed_entries" + ); + ZSTD_decompress( + decompressed_entries, + node->entries_size, + node->entries, + compressed_sz + ); + *entries_dst = decompressed_entries; +#endif // HAVE_LIBZSTD == 0 + + } else { + // Not compressed, no need to decompress + *entries_dst = node->entries; + *string_table_dst = node->string_table; + } +} ===================================== rts/IPE.h ===================================== @@ -17,5 +17,6 @@ void dumpIPEToEventLog(void); void updateIpeMap(void); void initIpe(void); void exitIpe(void); +void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode*, IpeBufferEntry**, char**); #include "EndPrivate.h" ===================================== rts/include/rts/IPE.h ===================================== @@ -52,9 +52,6 @@ typedef uint32_t StringIdx; // The size of this must be a multiple of the word size // to ensure correct packing. typedef struct { - // When TNTC is enabled this will point to the entry code - // not the info table itself. - const StgInfoTable *info; StringIdx table_name; StringIdx closure_desc; StringIdx ty_desc; @@ -69,10 +66,23 @@ GHC_STATIC_ASSERT(sizeof(IpeBufferEntry) % (WORD_SIZE_IN_BITS / 8) == 0, "sizeof typedef struct IpeBufferListNode_ { struct IpeBufferListNode_ *next; + // Everything below is read-only and generated by the codegen - const char *string_table; + + // This flag should be treated as a boolean + StgWord compressed; + StgWord count; - IpeBufferEntry entries[]; + + // When TNTC is enabled, these will point to the entry code + // not the info table itself. + StgInfoTable **tables; + + IpeBufferEntry *entries; + StgWord entries_size; // decompressed size + + char *string_table; + StgWord string_table_size; // decompressed size } IpeBufferListNode; void registerInfoProvList(IpeBufferListNode *node); ===================================== rts/rts.cabal.in ===================================== @@ -45,6 +45,10 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ +flag libzstd + default: @CabalHaveLibZstd@ +flag static-libzstd + default: @CabalStaticLibZstd@ flag 64bit default: @Cabal64bit@ flag leading-underscore @@ -212,6 +216,14 @@ library extra-libraries: elf dw if flag(libnuma) extra-libraries: numa + if flag(libzstd) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + extra-libraries: zstd if !flag(smp) cpp-options: -DNOSMP ===================================== testsuite/tests/javascript/T23101.hs ===================================== @@ -0,0 +1,22 @@ + +foreign import javascript "(($1) => { return $1; })" + bool_id :: Bool -> Bool + +foreign import javascript "(($1) => { return !$1; })" + bool_not :: Bool -> Bool + +foreign import javascript "(($1) => { console.log($1); })" + bool_log :: Bool -> IO () + +main :: IO () +main = do + bool_log True + bool_log False + bool_log (bool_id True) + bool_log (bool_id False) + bool_log (bool_not True) + bool_log (bool_not False) + print (bool_id True) + print (bool_id False) + print (bool_not True) + print (bool_not False) ===================================== testsuite/tests/javascript/T23101.stdout ===================================== @@ -0,0 +1,10 @@ +true +false +true +false +false +true +True +False +False +True ===================================== testsuite/tests/javascript/all.T ===================================== @@ -0,0 +1,4 @@ +# These are JavaScript-specific tests +setTestOpts(when(not(js_arch()),skip)) + +test('T23101', normal, compile_and_run, ['']) ===================================== testsuite/tests/rts/ipe/ipeEventLog_fromMap.c ===================================== @@ -19,7 +19,7 @@ int main(int argc, char *argv[]) { registerInfoProvList(list2); // Query an IPE to initialize the underlying hash map. - lookupIPE(list1->entries[0].info); + lookupIPE(list1->tables[0]); // Trace all IPE events. dumpIPEToEventLog(); ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -40,15 +40,23 @@ void shouldFindNothingInAnEmptyIPEMap(Capability *cap) { } HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *)); + node->entries = malloc(sizeof(IpeBufferEntry)); + StringTable st; init_string_table(&st); HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); - node->entries[0] = makeAnyProvEntry(cap, &st, fortyTwo, 42); - node->count = 1; node->next = NULL; + node->compressed = 0; + node->count = 1; + node->tables[0] = get_itbl(fortyTwo); + node->entries[0] = makeAnyProvEntry(cap, &st, 42); + node->entries_size = sizeof(IpeBufferEntry); node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -72,15 +80,23 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, HaskellObj fortyTwo) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *)); + node->entries = malloc(sizeof(IpeBufferEntry)); + StringTable st; init_string_table(&st); HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); - node->entries[0] = makeAnyProvEntry(cap, &st, twentyThree, 23); - node->count = 1; node->next = NULL; + node->compressed = 0; + node->count = 1; + node->tables[0] = get_itbl(twentyThree); + node->entries[0] = makeAnyProvEntry(cap, &st, 23); + node->entries_size = sizeof(IpeBufferEntry); node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -103,17 +119,26 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, } void shouldFindTwoFromTheSameList(Capability *cap) { - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + 2 * sizeof(IpeBufferEntry)); + // Allocate buffers for IPE buffer list node + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *) * 2); + node->entries = malloc(sizeof(IpeBufferEntry) * 2); + StringTable st; init_string_table(&st); HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2)); - node->entries[0] = makeAnyProvEntry(cap, &st, one, 1); - node->entries[1] = makeAnyProvEntry(cap, &st, two, 2); - node->count = 2; node->next = NULL; + node->compressed = 0; + node->count = 2; + node->tables[0] = get_itbl(one); + node->tables[1] = get_itbl(two); + node->entries[0] = makeAnyProvEntry(cap, &st, 1); + node->entries[1] = makeAnyProvEntry(cap, &st, 2); + node->entries_size = sizeof(IpeBufferEntry) * 2; node->string_table = st.buffer; + node->string_table_size = st.size; registerInfoProvList(node); @@ -136,6 +161,7 @@ void shouldFindTwoFromTheSameList(Capability *cap) { void shouldDealWithAnEmptyList(Capability *cap, HaskellObj fortyTwo) { IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); node->count = 0; + node->compressed = 0; node->next = NULL; node->string_table = ""; ===================================== testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -25,9 +25,8 @@ uint32_t add_string(StringTable *st, const char *s) { return n; } -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i) { +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { IpeBufferEntry provEnt; - provEnt.info = get_itbl(closure); unsigned int tableNameLength = strlen("table_name_") + 3 /* digits */ + 1 /* null character */; char *tableName = malloc(sizeof(char) * tableNameLength); @@ -69,15 +68,27 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj clo IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) { const int n = end - start; - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + n * sizeof(IpeBufferEntry)); + + // Allocate buffers for IpeBufferListNode + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->tables = malloc(sizeof(StgInfoTable *) * n); + node->entries = malloc(sizeof(IpeBufferEntry) * n); + StringTable st; init_string_table(&st); + + // Make the entries and fill the buffers for (int i=start; i < end; i++) { HaskellObj closure = rts_mkInt(cap, 42); - node->entries[i] = makeAnyProvEntry(cap, &st, closure, i); + node->tables[i] = get_itbl(closure); + node->entries[i] = makeAnyProvEntry(cap, &st, i); } + + // Set the rest of the fields node->next = NULL; + node->compressed = 0; node->count = n; node->string_table = st.buffer; + return node; } ===================================== testsuite/tests/rts/ipe/ipe_lib.h ===================================== @@ -12,6 +12,6 @@ void init_string_table(StringTable *st); uint32_t add_string(StringTable *st, const char *s); IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end); -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i); +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i); void dumpIPEToEventLog(void); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1bed0580e3d6ff19b3e1627232b689aca09c0a4a...4db6e54eb3986e22fd4135fcb261951b6de046bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1bed0580e3d6ff19b3e1627232b689aca09c0a4a...4db6e54eb3986e22fd4135fcb261951b6de046bd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 16:50:40 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 13 Mar 2023 12:50:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/hardwire-ghc-unit-id Message-ID: <640f546038323_36ed6c4fd899c05104bd@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/hardwire-ghc-unit-id You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 16:51:48 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 13 Mar 2023 12:51:48 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] Hardwire a better unit-id for ghc Message-ID: <640f54a4452de_36ed6c4fd899d45106ef@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 702bd403 by romes at 2023-03-13T16:51:20+00:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Version` whose value is the new unit-id. This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash, ensure cabal-built ghcs also correctly use a better unit-id, and check compatibility when loading plugins. - - - - - 6 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Unit/Types.hs - compiler/ghc.cabal.in - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4703,6 +4703,7 @@ compilerInfo dflags ("Project Patch Level", cProjectPatchLevel), ("Project Patch Level1", cProjectPatchLevel1), ("Project Patch Level2", cProjectPatchLevel2), + ("Project Unit Id", cProjectUnitId), ("Booter version", cBooterVersion), ("Stage", cStage), ("Build platform", cBuildPlatformString), ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -99,6 +99,7 @@ import GHC.Data.FastString import GHC.Utils.Encoding import GHC.Utils.Fingerprint import GHC.Utils.Misc +import GHC.Version (cProjectUnitId) import Control.DeepSeq import Data.Data @@ -597,7 +598,7 @@ primUnitId = UnitId (fsLit "ghc-prim") bignumUnitId = UnitId (fsLit "ghc-bignum") baseUnitId = UnitId (fsLit "base") rtsUnitId = UnitId (fsLit "rts") -thisGhcUnitId = UnitId (fsLit "ghc") +thisGhcUnitId = UnitId (fsLit cProjectUnitId) interactiveUnitId = UnitId (fsLit "interactive") thUnitId = UnitId (fsLit "template-haskell") ===================================== compiler/ghc.cabal.in ===================================== @@ -57,6 +57,12 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +-- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` +Flag hadrian-stage0 + Description: Enable if compiling the stage0 compiler with hadrian + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -136,9 +142,10 @@ Library Include-Dirs: . - -- We need to set the unit id to ghc (without a version number) - -- as it's magic. - GHC-Options: -this-unit-id ghc + if flag(hadrian-stage0) + -- We need to set the unit id to ghc (without a version number) + -- as it's magic. + GHC-Options: -this-unit-id ghc c-sources: cbits/cutils.c ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -533,6 +533,13 @@ generateVersionHs = do cProjectPatchLevel <- getSetting ProjectPatchLevel cProjectPatchLevel1 <- getSetting ProjectPatchLevel1 cProjectPatchLevel2 <- getSetting ProjectPatchLevel2 + -- ROMES:TODO: First we attempt a fixed unit-id with version but without hash. + -- We now use a more informative + -- unit-id for ghc. This same logic must be done + -- when passing -this-unit-id when building ghc (at + -- stage0 one must pass -this-unit-id ghc). + let cProjectUnitId = "ghc-" ++ cProjectVersion + return $ unlines [ "module GHC.Version where" , "" @@ -555,6 +562,9 @@ generateVersionHs = do , "" , "cProjectPatchLevel2 :: String" , "cProjectPatchLevel2 = " ++ show cProjectPatchLevel2 + , "" + , "cProjectUnitId :: String" + , "cProjectUnitId = " ++ show cProjectUnitId ] -- | Generate @Platform/Host.hs@ files. ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -115,6 +115,12 @@ commonCabalArgs stage = do , arg "--htmldir" , arg $ "${pkgroot}/../../doc/html/libraries/" ++ package_id + -- ROMES: While the boot compiler is not updated wrt -this-unit-id + -- not being fixed to `ghc`, when building stage0, we must set + -- -this-unit-id to `ghc` because the boot compiler expects that. + -- We do it through a cabal flag in ghc.cabal + , stage0 ? arg "-f+hadrian-stage0" + -- These trigger a need on each dependency, so every important to need -- them in parallel or it linearises the build of Ghc and GhcPkg , withStageds [Ghc CompileHs, GhcPkg Update, Cc CompileC, Ar Pack] ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -245,8 +245,19 @@ wayGhcArgs = do packageGhcArgs :: Args packageGhcArgs = do + stage <- getStage package <- getPackage - ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) + ghc_ver <- readVersion <$> expr (ghcVersionStage stage) + -- ROMES: Until the boot compiler no longer needs ghc's + -- unit-id to be "ghc", the stage0 compiler must be built + -- with `-this-unit-id ghc`, while the wired-in unit-id of + -- ghc is correctly set to the unit-id we'll generate for + -- stage1 (set in generateVersionHs in Rules.Generate). + -- + -- However, we don't need to set the unit-id of "ghc" to "ghc" when + -- building stage0 because we have a flag in compiler/ghc.cabal.in that is + -- sets `-this-unit-id ghc` when hadrian is building stage0, which will + -- overwrite this one. pkgId <- expr $ pkgIdentifier package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/702bd4035e70005e010177988f23e4eea65d7631 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/702bd4035e70005e010177988f23e4eea65d7631 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 17:10:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 13 Mar 2023 13:10:03 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-bignum-redundancy Message-ID: <640f58ebeb3a8_36ed6c502354b0524655@gitlab.mail> Ben Gamari pushed new branch wip/ghc-bignum-redundancy at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-bignum-redundancy You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 18:16:58 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 13 Mar 2023 14:16:58 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] 2 commits: Hardwire a better unit-id for ghc Message-ID: <640f689a3adef_36ed6c5154ee5c537736@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: bbaab475 by romes at 2023-03-13T17:48:15+00:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Version` whose value is the new unit-id. This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash, ensure cabal-built ghcs also correctly use a better unit-id, and check compatibility when loading plugins. - - - - - b98bb6d5 by romes at 2023-03-13T18:16:43+00:00 Ensure ghc's unit key matches unit id - - - - - 6 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Unit/Types.hs - compiler/ghc.cabal.in - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4703,6 +4703,7 @@ compilerInfo dflags ("Project Patch Level", cProjectPatchLevel), ("Project Patch Level1", cProjectPatchLevel1), ("Project Patch Level2", cProjectPatchLevel2), + ("Project Unit Id", cProjectUnitId), ("Booter version", cBooterVersion), ("Stage", cStage), ("Build platform", cBuildPlatformString), ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -99,6 +99,7 @@ import GHC.Data.FastString import GHC.Utils.Encoding import GHC.Utils.Fingerprint import GHC.Utils.Misc +import GHC.Version (cProjectUnitId) import Control.DeepSeq import Data.Data @@ -597,7 +598,7 @@ primUnitId = UnitId (fsLit "ghc-prim") bignumUnitId = UnitId (fsLit "ghc-bignum") baseUnitId = UnitId (fsLit "base") rtsUnitId = UnitId (fsLit "rts") -thisGhcUnitId = UnitId (fsLit "ghc") +thisGhcUnitId = UnitId (fsLit cProjectUnitId) interactiveUnitId = UnitId (fsLit "interactive") thUnitId = UnitId (fsLit "template-haskell") @@ -625,8 +626,15 @@ wiredInUnitIds = , baseUnitId , rtsUnitId , thUnitId - , thisGhcUnitId ] + -- NB: ghc is no longer part of the wired-in units since its unit-id, given + -- by hadrian or cabal, is no longer overwritten and now matches both the + -- cProjectUnitId defined in build-time-generated module GHC.Version, and + -- the unit key. + -- + -- See also Note [About units], taking into consideration ghc is still a + -- wired-in unit but whose unit-id no longer needs special handling because + -- we take care that it matches the unit key. --------------------------------------------------------------------- -- Boot Modules ===================================== compiler/ghc.cabal.in ===================================== @@ -57,6 +57,12 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +-- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` +Flag hadrian-stage0 + Description: Enable if compiling the stage0 compiler with hadrian + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -136,9 +142,10 @@ Library Include-Dirs: . - -- We need to set the unit id to ghc (without a version number) - -- as it's magic. - GHC-Options: -this-unit-id ghc + if flag(hadrian-stage0) + -- We need to set the unit id to ghc (without a version number) + -- as it's magic. + GHC-Options: -this-unit-id ghc c-sources: cbits/cutils.c ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -533,6 +533,19 @@ generateVersionHs = do cProjectPatchLevel <- getSetting ProjectPatchLevel cProjectPatchLevel1 <- getSetting ProjectPatchLevel1 cProjectPatchLevel2 <- getSetting ProjectPatchLevel2 + cProjectVersionMunged <- getSetting ProjectVersionMunged + -- ROMES:TODO: First we attempt a fixed unit-id with version but without hash. + -- We now use a more informative unit-id for ghc. This same logic must be + -- done when passing -this-unit-id when building ghc (at stage0 one must + -- pass -this-unit-id ghc). + -- + -- It's crucial that the unit-id matches the unit-key -- ghc is no longer + -- part of the WiringMap, so we don't to go back and forth between the + -- unit-id and the unit-key, because we take care here that they are the same. + -- + -- One worry: How to guarantee this is the same when we install ghc with cabal + let cProjectUnitId = "ghc-" ++ cProjectVersionMunged + return $ unlines [ "module GHC.Version where" , "" @@ -555,6 +568,9 @@ generateVersionHs = do , "" , "cProjectPatchLevel2 :: String" , "cProjectPatchLevel2 = " ++ show cProjectPatchLevel2 + , "" + , "cProjectUnitId :: String" + , "cProjectUnitId = " ++ show cProjectUnitId ] -- | Generate @Platform/Host.hs@ files. ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -247,6 +247,16 @@ packageGhcArgs :: Args packageGhcArgs = do package <- getPackage ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) + -- ROMES: Until the boot compiler no longer needs ghc's + -- unit-id to be "ghc", the stage0 compiler must be built + -- with `-this-unit-id ghc`, while the wired-in unit-id of + -- ghc is correctly set to the unit-id we'll generate for + -- stage1 (set in generateVersionHs in Rules.Generate). + -- + -- However, we don't need to set the unit-id of "ghc" to "ghc" when + -- building stage0 because we have a flag in compiler/ghc.cabal.in that is + -- sets `-this-unit-id ghc` when hadrian is building stage0, which will + -- overwrite this one. pkgId <- expr $ pkgIdentifier package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -77,6 +77,11 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + -- ROMES: While the boot compiler is not updated wrt -this-unit-id + -- not being fixed to `ghc`, when building stage0, we must set + -- -this-unit-id to `ghc` because the boot compiler expects that. + -- We do it through a cabal flag in ghc.cabal + , stage0 ? arg "+hadrian-stage0" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/702bd4035e70005e010177988f23e4eea65d7631...b98bb6d5a5ea0bbffb9b6ecd1fe3db635770e390 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/702bd4035e70005e010177988f23e4eea65d7631...b98bb6d5a5ea0bbffb9b6ecd1fe3db635770e390 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 19:37:06 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 13 Mar 2023 15:37:06 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Simplifier: `countValArgs` should not count Type args (#23102) Message-ID: <640f7b62726c2_36ed6c52a6a14c5435b4@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - 06aa32c6 by Ben Gamari at 2023-03-13T15:37:01-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - 3 changed files: - compiler/GHC/Core/Opt/Simplify/Utils.hs - libraries/Win32 - libraries/ghc-bignum/ghc-bignum.cabal Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -553,7 +553,7 @@ countArgs _ = 0 countValArgs :: SimplCont -> Int -- Count value arguments only -countValArgs (ApplyToTy { sc_cont = cont }) = 1 + countValArgs cont +countValArgs (ApplyToTy { sc_cont = cont }) = countValArgs cont countValArgs (ApplyToVal { sc_cont = cont }) = 1 + countValArgs cont countValArgs (CastIt _ cont) = countValArgs cont countValArgs _ = 0 ===================================== libraries/Win32 ===================================== @@ -1 +1 @@ -Subproject commit 931497f7052f63cb5cfd4494a94e572c5c570642 +Subproject commit efab7f1146da9741dc54fb35476d4aaabeff8d6d ===================================== libraries/ghc-bignum/ghc-bignum.cabal ===================================== @@ -89,8 +89,6 @@ library -- "ghc-bignum" and not "ghc-bignum-1.0". ghc-options: -this-unit-id ghc-bignum - include-dirs: include - if flag(gmp) cpp-options: -DBIGNUM_GMP other-modules: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d55dacfef2e8384761367faa5893fe38e24822ef...06aa32c662bd622c3f30e48b132c880a99ed3128 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d55dacfef2e8384761367faa5893fe38e24822ef...06aa32c662bd622c3f30e48b132c880a99ed3128 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 20:24:16 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 13 Mar 2023 16:24:16 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] 2 commits: Hardwire a better unit-id for ghc Message-ID: <640f8670a5477_36ed6c5381cc54548974@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 2a259787 by romes at 2023-03-13T20:23:58+00:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Version` whose value is the new unit-id. This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash, ensure cabal-built ghcs also correctly use a better unit-id, and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id, and no longer add ghc to the WiringMap - - - - - f5444fdc by romes at 2023-03-13T20:24:02+00:00 Validate compatibility of ghcs when loading plugins - - - - - 10 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Unit/Types.hs - compiler/ghc.cabal.in - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Packages.hs - + testsuite/ghc-config/ghc-config - testsuite/tests/driver/j-space/jspace.hs - utils/count-deps/Main.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4703,6 +4703,7 @@ compilerInfo dflags ("Project Patch Level", cProjectPatchLevel), ("Project Patch Level1", cProjectPatchLevel1), ("Project Patch Level2", cProjectPatchLevel2), + ("Project Unit Id", cProjectUnitId), ("Booter version", cBooterVersion), ("Stage", cStage), ("Build platform", cBuildPlatformString), ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -42,10 +42,10 @@ import GHC.Driver.Env import GHCi.RemoteTypes ( HValue ) import GHC.Core.Type ( Type, mkTyConTy ) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.TyCon ( TyCon ) +import GHC.Core.TyCon ( TyCon(tyConName) ) import GHC.Types.SrcLoc ( noSrcSpan ) -import GHC.Types.Name ( Name, nameModule_maybe ) +import GHC.Types.Name ( Name, nameModule, nameModule_maybe ) import GHC.Types.Id ( idType ) import GHC.Types.TyThing import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS ) @@ -55,7 +55,7 @@ import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) import GHC.Driver.Config.Finder ( initFinderOpts ) -import GHC.Unit.Module ( Module, ModuleName ) +import GHC.Unit.Module ( Module, ModuleName, thisGhcUnit, GenModule(moduleUnit) ) import GHC.Unit.Module.ModIface import GHC.Unit.Env @@ -171,7 +171,14 @@ loadPlugin' occ_name plugin_name hsc_env mod_name Just (name, mod_iface) -> do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name - ; eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) + ; case thisGhcUnit == (moduleUnit . nameModule . tyConName) plugin_tycon of { + False -> + throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep + [ text "The plugin module", ppr mod_name + , text "was built with a compiler that is incompatible with the one loading it" + ]) ; + True -> + do { eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) ; case eith_plugin of Left actual_type -> throwGhcExceptionIO (CmdLineError $ @@ -182,7 +189,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name , text "did not have the type" , text "GHC.Plugins.Plugin" , text "as required"]) - Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } + Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } } } -- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -99,6 +99,7 @@ import GHC.Data.FastString import GHC.Utils.Encoding import GHC.Utils.Fingerprint import GHC.Utils.Misc +import GHC.Version (cProjectUnitId) import Control.DeepSeq import Data.Data @@ -597,7 +598,7 @@ primUnitId = UnitId (fsLit "ghc-prim") bignumUnitId = UnitId (fsLit "ghc-bignum") baseUnitId = UnitId (fsLit "base") rtsUnitId = UnitId (fsLit "rts") -thisGhcUnitId = UnitId (fsLit "ghc") +thisGhcUnitId = UnitId (fsLit cProjectUnitId) interactiveUnitId = UnitId (fsLit "interactive") thUnitId = UnitId (fsLit "template-haskell") @@ -625,8 +626,15 @@ wiredInUnitIds = , baseUnitId , rtsUnitId , thUnitId - , thisGhcUnitId ] + -- NB: ghc is no longer part of the wired-in units since its unit-id, given + -- by hadrian or cabal, is no longer overwritten and now matches both the + -- cProjectUnitId defined in build-time-generated module GHC.Version, and + -- the unit key. + -- + -- See also Note [About units], taking into consideration ghc is still a + -- wired-in unit but whose unit-id no longer needs special handling because + -- we take care that it matches the unit key. --------------------------------------------------------------------- -- Boot Modules ===================================== compiler/ghc.cabal.in ===================================== @@ -57,6 +57,12 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +-- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` +Flag hadrian-stage0 + Description: Enable if compiling the stage0 compiler with hadrian + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -136,9 +142,10 @@ Library Include-Dirs: . - -- We need to set the unit id to ghc (without a version number) - -- as it's magic. - GHC-Options: -this-unit-id ghc + if flag(hadrian-stage0) + -- We need to set the unit id to ghc (without a version number) + -- as it's magic. + GHC-Options: -this-unit-id ghc c-sources: cbits/cutils.c ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -533,6 +533,19 @@ generateVersionHs = do cProjectPatchLevel <- getSetting ProjectPatchLevel cProjectPatchLevel1 <- getSetting ProjectPatchLevel1 cProjectPatchLevel2 <- getSetting ProjectPatchLevel2 + cProjectVersionMunged <- getSetting ProjectVersionMunged + -- ROMES:TODO: First we attempt a fixed unit-id with version but without hash. + -- We now use a more informative unit-id for ghc. This same logic must be + -- done when passing -this-unit-id when building ghc (at stage0 one must + -- pass -this-unit-id ghc). + -- + -- It's crucial that the unit-id matches the unit-key -- ghc is no longer + -- part of the WiringMap, so we don't to go back and forth between the + -- unit-id and the unit-key, because we take care here that they are the same. + -- + -- One worry: How to guarantee this is the same when we install ghc with cabal + let cProjectUnitId = "ghc-" ++ cProjectVersionMunged + return $ unlines [ "module GHC.Version where" , "" @@ -555,6 +568,9 @@ generateVersionHs = do , "" , "cProjectPatchLevel2 :: String" , "cProjectPatchLevel2 = " ++ show cProjectPatchLevel2 + , "" + , "cProjectUnitId :: String" + , "cProjectUnitId = " ++ show cProjectUnitId ] -- | Generate @Platform/Host.hs@ files. ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -247,6 +247,16 @@ packageGhcArgs :: Args packageGhcArgs = do package <- getPackage ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) + -- ROMES: Until the boot compiler no longer needs ghc's + -- unit-id to be "ghc", the stage0 compiler must be built + -- with `-this-unit-id ghc`, while the wired-in unit-id of + -- ghc is correctly set to the unit-id we'll generate for + -- stage1 (set in generateVersionHs in Rules.Generate). + -- + -- However, we don't need to set the unit-id of "ghc" to "ghc" when + -- building stage0 because we have a flag in compiler/ghc.cabal.in that is + -- sets `-this-unit-id ghc` when hadrian is building stage0, which will + -- overwrite this one. pkgId <- expr $ pkgIdentifier package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -77,6 +77,11 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + -- ROMES: While the boot compiler is not updated wrt -this-unit-id + -- not being fixed to `ghc`, when building stage0, we must set + -- -this-unit-id to `ghc` because the boot compiler expects that. + -- We do it through a cabal flag in ghc.cabal + , stage0 ? arg "+hadrian-stage0" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] ===================================== testsuite/ghc-config/ghc-config ===================================== Binary files /dev/null and b/testsuite/ghc-config/ghc-config differ ===================================== testsuite/tests/driver/j-space/jspace.hs ===================================== @@ -2,6 +2,7 @@ module Main where import GHC import GHC.Driver.Monad +import GHC.Driver.Session import System.Environment import GHC.Driver.Env.Types import GHC.Profiling @@ -25,6 +26,9 @@ initGhcM xs = do let cmdOpts = ["-fforce-recomp"] ++ xs (df2, leftovers, _) <- parseDynamicFlags (hsc_logger session) df1 (map noLoc cmdOpts) setSessionDynFlags df2 + ghcUnitId <- case lookup "Project Unit Id" (compilerInfo df2) of + Nothing -> fail "failed to find ghc's unit-id in the compiler info" + Just ghcUnitId -> pure ghcUnitId ts <- mapM (\s -> guessTarget s Nothing Nothing) $ map unLoc leftovers setTargets ts _ <- load LoadAllTargets @@ -36,7 +40,7 @@ initGhcM xs = do liftIO $ do requestHeapCensus performGC - [ys] <- filter (isPrefixOf "ghc:GHC.Unit.Module.ModDetails.ModDetails") . lines <$> readFile "jspace.hp" + [ys] <- filter (isPrefixOf (ghcUnitId <> ":GHC.Unit.Module.ModDetails.ModDetails")) . lines <$> readFile "jspace.hp" let (n :: Int) = read (last (words ys)) -- The output should be 50 * 8 * word_size (i.e. 3200, or 1600 on 32-bit architectures): -- the test contains DEPTH + WIDTH + 2 = 50 modules J, H_0, .., H_DEPTH, W_1, .., W_WIDTH, ===================================== utils/count-deps/Main.hs ===================================== @@ -56,25 +56,28 @@ calcDeps modName libdir = logger <- getLogger (df, _, _) <- parseDynamicFlags logger df [noLoc "-package=ghc"] setSessionDynFlags df - env <- getSession - loop env Map.empty [mkModuleName modName] + case lookup "Project Unit Id" (compilerInfo df) of + Nothing -> fail "failed to find ghc's unit-id in the compiler info" + Just ghcUnitId -> do + env <- getSession + loop ghcUnitId env Map.empty [mkModuleName modName] where -- Source imports are only guaranteed to show up in the 'mi_deps' -- of modules that import them directly and don’t propagate -- transitively so we loop. - loop :: HscEnv -> Map.Map ModuleName [ModuleName] -> [ModuleName] -> Ghc (Map.Map ModuleName [ModuleName]) - loop env modules (m : ms) = + loop :: String -> HscEnv -> Map.Map ModuleName [ModuleName] -> [ModuleName] -> Ghc (Map.Map ModuleName [ModuleName]) + loop ghcUnitId env modules (m : ms) = if m `Map.member` modules - then loop env modules ms + then loop ghcUnitId env modules ms else do - mi <- liftIO $ hscGetModuleInterface env (mkModule m) + mi <- liftIO $ hscGetModuleInterface env (mkModule ghcUnitId m) let deps = modDeps mi modules <- return $ Map.insert m [] modules - loop env (Map.insert m deps modules) $ ms ++ filter (not . (`Map.member` modules)) deps - loop _ modules [] = return modules + loop ghcUnitId env (Map.insert m deps modules) $ ms ++ filter (not . (`Map.member` modules)) deps + loop _ _ modules [] = return modules - mkModule :: ModuleName -> Module - mkModule = Module (stringToUnit "ghc") + mkModule :: String -> ModuleName -> Module + mkModule ghcUnitId = Module (stringToUnit ghcUnitId) modDeps :: ModIface -> [ModuleName] modDeps mi = map (gwib_mod . snd) $ Set.toList $ dep_direct_mods (mi_deps mi) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b98bb6d5a5ea0bbffb9b6ecd1fe3db635770e390...f5444fdc215485cefd6f928746fce545c68beea7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b98bb6d5a5ea0bbffb9b6ecd1fe3db635770e390...f5444fdc215485cefd6f928746fce545c68beea7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 22:37:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 13 Mar 2023 18:37:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] ghc-bignum: Drop redundant include-dirs field Message-ID: <640fa5bacdd4f_36ed6c558f3388561326@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4fb1cc2a by Ben Gamari at 2023-03-13T18:37:44-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - 1 changed file: - libraries/ghc-bignum/ghc-bignum.cabal Changes: ===================================== libraries/ghc-bignum/ghc-bignum.cabal ===================================== @@ -89,8 +89,6 @@ library -- "ghc-bignum" and not "ghc-bignum-1.0". ghc-options: -this-unit-id ghc-bignum - include-dirs: include - if flag(gmp) cpp-options: -DBIGNUM_GMP other-modules: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4fb1cc2a7132e6cbc860d04416881f4ec83f033c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4fb1cc2a7132e6cbc860d04416881f4ec83f033c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 23:14:51 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 13 Mar 2023 19:14:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22194-flags Message-ID: <640fae6b44f3_36ed6c563dd2d05667e1@gitlab.mail> Simon Peyton Jones pushed new branch wip/T22194-flags at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22194-flags You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 13 23:39:33 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 13 Mar 2023 19:39:33 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Wibble Message-ID: <640fb4353a444_36ed6c56b5425c5688dd@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: dad36c73 by Simon Peyton Jones at 2023-03-13T23:40:45+00:00 Wibble - - - - - 1 changed file: - compiler/GHC/Tc/Solver/Monad.hs Changes: ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -189,10 +189,10 @@ import Data.Foldable import qualified Data.Semigroup as S #if defined(DEBUG) +import GHC.Types.Unique.Set (nonDetEltsUniqSet) import GHC.Data.Graph.Directed #endif - {- ********************************************************************* * * StopOrContinue View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dad36c7368362477a5282c4020b2411e6fb15bca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dad36c7368362477a5282c4020b2411e6fb15bca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 14 01:18:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 13 Mar 2023 21:18:02 -0400 Subject: [Git][ghc/ghc][master] Bump Win32 to 2.13.4.0 Message-ID: <640fcb4af1d20_36ed6c584d78dc5737c7@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - 1 changed file: - libraries/Win32 Changes: ===================================== libraries/Win32 ===================================== @@ -1 +1 @@ -Subproject commit 931497f7052f63cb5cfd4494a94e572c5c570642 +Subproject commit efab7f1146da9741dc54fb35476d4aaabeff8d6d View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/536d1f90020dfd74c9e4211e128e051317da5bf6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/536d1f90020dfd74c9e4211e128e051317da5bf6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 14 01:18:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 13 Mar 2023 21:18:39 -0400 Subject: [Git][ghc/ghc][master] ghc-bignum: Drop redundant include-dirs field Message-ID: <640fcb6f2efe1_36ed6c584d78dc57705d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - 1 changed file: - libraries/ghc-bignum/ghc-bignum.cabal Changes: ===================================== libraries/ghc-bignum/ghc-bignum.cabal ===================================== @@ -89,8 +89,6 @@ library -- "ghc-bignum" and not "ghc-bignum-1.0". ghc-options: -this-unit-id ghc-bignum - include-dirs: include - if flag(gmp) cpp-options: -DBIGNUM_GMP other-modules: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee17001e54c3c6adccc5e3b67b629655c14da43a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee17001e54c3c6adccc5e3b67b629655c14da43a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 14 15:25:16 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 14 Mar 2023 11:25:16 -0400 Subject: [Git][ghc/ghc][wip/js-exports] JS FFI: add tests for known broken uses Message-ID: <641091dcea044_37e76b9fe0cf0146748@gitlab.mail> Josh Meredith pushed to branch wip/js-exports at Glasgow Haskell Compiler / GHC Commits: 4f8168d2 by Josh Meredith at 2023-03-14T15:25:01+00:00 JS FFI: add tests for known broken uses - - - - - 7 changed files: - testsuite/tests/javascript/all.T - testsuite/tests/javascript/js-callback01.hs - testsuite/tests/javascript/js-callback01.stdout - + testsuite/tests/javascript/js-callback04.hs - + testsuite/tests/javascript/js-callback04.stdout - + testsuite/tests/javascript/js-callback05.hs - + testsuite/tests/javascript/js-callback05.stdout Changes: ===================================== testsuite/tests/javascript/all.T ===================================== @@ -13,3 +13,5 @@ test('js-ffi-array', normal, compile_and_run, ['']) test('js-callback01', normal, compile_and_run, ['']) test('js-callback02', normal, compile_and_run, ['']) test('js-callback03', normal, compile_and_run, ['']) +test('js-callback04', js_skip, compile_and_run, ['']) +test('js-callback05', js_skip, compile_and_run, ['']) ===================================== testsuite/tests/javascript/js-callback01.hs ===================================== @@ -2,7 +2,7 @@ import GHC.JS.Prim import GHC.JS.Foreign.Callback import Control.Concurrent -foreign import javascript "(() => { console.log('test0'); })" +foreign import javascript "(() => { console.log('test'); })" js_log0 :: IO () foreign import javascript "((x) => { console.log(x); })" @@ -28,7 +28,7 @@ foreign import javascript "((f,x,y,z) => { f(x,y,z); })" main :: IO () main = do - log0 <- syncCallback ThrowWouldBlock js_log0 -- (putStrLn "test0") + log0 <- syncCallback ThrowWouldBlock js_log0 log1 <- syncCallback1 ThrowWouldBlock js_log1 log2 <- syncCallback2 ThrowWouldBlock js_log2 log3 <- syncCallback3 ThrowWouldBlock js_log3 @@ -38,14 +38,14 @@ main = do js_apply2_ log2 (toJSString "test2x") (toJSString "test2y") js_apply3_ log3 (toJSString "test3x") (toJSString "test3y") (toJSString "test3z") - log0' <- asyncCallback js_log0 -- (putStrLn "test0") + log0' <- asyncCallback js_log0 log1' <- asyncCallback1 js_log1 log2' <- asyncCallback2 js_log2 log3' <- asyncCallback3 js_log3 js_apply0_ log0' - js_apply1_ log1' (toJSString "test1x") - js_apply2_ log2' (toJSString "test2x") (toJSString "test2y") - js_apply3_ log3' (toJSString "test3x") (toJSString "test3y") (toJSString "test3z") + js_apply1_ log1' (toJSString "test") + js_apply2_ log2' (toJSString "test") (toJSString "test") + js_apply3_ log3' (toJSString "test") (toJSString "test") (toJSString "test") threadDelay 1000000 -- Wait long enough for the async actions to complete ===================================== testsuite/tests/javascript/js-callback01.stdout ===================================== @@ -1,14 +1,14 @@ -test0 -test1x -test2x -test2y -test3x -test3y -test3z -test0 +test test1x test2x test2y test3x test3y test3z +test +test +test +test +test +test +test ===================================== testsuite/tests/javascript/js-callback04.hs ===================================== @@ -0,0 +1,16 @@ +import GHC.JS.Prim +import GHC.JS.Foreign.Callback + +foreign import javascript "(() => { console.log('javascript'); })" + js_log :: IO () + +foreign import javascript "((f) => { f(); })" + js_apply0_ :: Callback (IO ()) -> IO () + +main :: IO () +main = do + logH <- syncCallback ThrowWouldBlock (putStrLn "haskell") + logJ <- syncCallback ThrowWouldBlock js_log + + js_apply0_ logH + js_apply0_ logJ ===================================== testsuite/tests/javascript/js-callback04.stdout ===================================== @@ -0,0 +1,2 @@ +haskell +javascript ===================================== testsuite/tests/javascript/js-callback05.hs ===================================== @@ -0,0 +1,12 @@ +import GHC.JS.Prim +import GHC.JS.Foreign.Callback +import System.IO + +foreign import javascript "((f) => { f(); })" + js_apply0_ :: Callback (IO ()) -> IO () + +main :: IO () +main = do + log <- syncCallback ThrowWouldBlock (putStrLn "test" >> hFlush stdout + js_apply0_ log + js_apply0_ log ===================================== testsuite/tests/javascript/js-callback05.stdout ===================================== @@ -0,0 +1,2 @@ +test +test View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f8168d259e6f884ae4f82fd139b03e818885dca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f8168d259e6f884ae4f82fd139b03e818885dca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 14 15:41:43 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 14 Mar 2023 11:41:43 -0400 Subject: [Git][ghc/ghc][wip/js-th] 40 commits: Account for local rules in specImports Message-ID: <641095b799d97_37e76ba5873341576eb@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - 73c47db9 by Sylvain Henry at 2023-03-14T16:18:30+01:00 Wire ghci unit - - - - - a8eadab2 by Sylvain Henry at 2023-03-14T16:18:30+01:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - b4c3eaa0 by Sylvain Henry at 2023-03-14T16:18:31+01:00 Don't use wired ghci - - - - - 239bdf31 by Sylvain Henry at 2023-03-14T16:18:31+01:00 Revert "Wire ghci unit" This reverts commit 448ee442d9bcd47ce1fe0bd70b77ae4cb71c6f38. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Runtime/Interpreter.hs - + compiler/GHC/Runtime/Interpreter/JS.hs - + compiler/GHC/Runtime/Interpreter/Process.hs - compiler/GHC/Runtime/Interpreter/Types.hs - + compiler/GHC/Runtime/Utils.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/353c6e4c58189c5e06739b3bc2a6d2bb7c9722cd...239bdf3194fe6275f9329378fb05507cb9af0f7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/353c6e4c58189c5e06739b3bc2a6d2bb7c9722cd...239bdf3194fe6275f9329378fb05507cb9af0f7b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 14 15:43:04 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 14 Mar 2023 11:43:04 -0400 Subject: [Git][ghc/ghc][wip/js-exports] JS FFI: update test case Message-ID: <6410960880aad_37e76ba588d4c16743@gitlab.mail> Josh Meredith pushed to branch wip/js-exports at Glasgow Haskell Compiler / GHC Commits: cbf77182 by Josh Meredith at 2023-03-14T15:42:53+00:00 JS FFI: update test case - - - - - 2 changed files: - testsuite/tests/javascript/js-callback05.hs - testsuite/tests/javascript/js-callback05.stdout Changes: ===================================== testsuite/tests/javascript/js-callback05.hs ===================================== @@ -7,6 +7,13 @@ foreign import javascript "((f) => { f(); })" main :: IO () main = do - log <- syncCallback ThrowWouldBlock (putStrLn "test" >> hFlush stdout + log <- syncCallback ThrowWouldBlock (putStrLn "test" >> hFlush stdout) js_apply0_ log js_apply0_ log + + log <- syncCallback ThrowWouldBlock (putStrLn "test1" >> hFlush stdout) + log <- syncCallback ThrowWouldBlock (putStrLn "test2" >> hFlush stdout) + log <- syncCallback ThrowWouldBlock (putStrLn "test3" >> hFlush stdout) + js_apply0_ log1 + js_apply0_ log2 + js_apply0_ log3 ===================================== testsuite/tests/javascript/js-callback05.stdout ===================================== @@ -1,2 +1,5 @@ test test +test1 +test2 +test3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cbf771828a7a8daca3d2408f79a962ec892719e5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cbf771828a7a8daca3d2408f79a962ec892719e5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 14 15:48:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 14 Mar 2023 11:48:58 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22872 Message-ID: <6410976a87d41_37e76ba80a64c1693e8@gitlab.mail> Ben Gamari pushed new branch wip/T22872 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22872 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 14 16:13:23 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 14 Mar 2023 12:13:23 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] 2 commits: Hardwire a better unit-id for ghc Message-ID: <64109d23e28ce_37e76baf860601799f3@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 45ea44ba by romes at 2023-03-14T16:13:03+00:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Version` whose value is the new unit-id. This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash, ensure cabal-built ghcs also correctly use a better unit-id, and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id, and no longer add ghc to the WiringMap - - - - - 0aa3abb8 by romes at 2023-03-14T16:13:12+00:00 Validate compatibility of ghcs when loading plugins - - - - - 9 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Unit/Types.hs - compiler/ghc.cabal.in - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Packages.hs - testsuite/tests/driver/j-space/jspace.hs - utils/count-deps/Main.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4703,6 +4703,7 @@ compilerInfo dflags ("Project Patch Level", cProjectPatchLevel), ("Project Patch Level1", cProjectPatchLevel1), ("Project Patch Level2", cProjectPatchLevel2), + ("Project Unit Id", cProjectUnitId), ("Booter version", cBooterVersion), ("Stage", cStage), ("Build platform", cBuildPlatformString), ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -42,10 +42,10 @@ import GHC.Driver.Env import GHCi.RemoteTypes ( HValue ) import GHC.Core.Type ( Type, mkTyConTy ) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.TyCon ( TyCon ) +import GHC.Core.TyCon ( TyCon(tyConName) ) import GHC.Types.SrcLoc ( noSrcSpan ) -import GHC.Types.Name ( Name, nameModule_maybe ) +import GHC.Types.Name ( Name, nameModule, nameModule_maybe ) import GHC.Types.Id ( idType ) import GHC.Types.TyThing import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS ) @@ -55,7 +55,7 @@ import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) import GHC.Driver.Config.Finder ( initFinderOpts ) -import GHC.Unit.Module ( Module, ModuleName ) +import GHC.Unit.Module ( Module, ModuleName, thisGhcUnit, GenModule(moduleUnit) ) import GHC.Unit.Module.ModIface import GHC.Unit.Env @@ -171,7 +171,14 @@ loadPlugin' occ_name plugin_name hsc_env mod_name Just (name, mod_iface) -> do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name - ; eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) + ; case thisGhcUnit == (moduleUnit . nameModule . tyConName) plugin_tycon of { + False -> + throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep + [ text "The plugin module", ppr mod_name + , text "was built with a compiler that is incompatible with the one loading it" + ]) ; + True -> + do { eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) ; case eith_plugin of Left actual_type -> throwGhcExceptionIO (CmdLineError $ @@ -182,7 +189,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name , text "did not have the type" , text "GHC.Plugins.Plugin" , text "as required"]) - Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } + Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } } } -- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -99,6 +99,7 @@ import GHC.Data.FastString import GHC.Utils.Encoding import GHC.Utils.Fingerprint import GHC.Utils.Misc +import GHC.Version (cProjectUnitId) import Control.DeepSeq import Data.Data @@ -597,7 +598,7 @@ primUnitId = UnitId (fsLit "ghc-prim") bignumUnitId = UnitId (fsLit "ghc-bignum") baseUnitId = UnitId (fsLit "base") rtsUnitId = UnitId (fsLit "rts") -thisGhcUnitId = UnitId (fsLit "ghc") +thisGhcUnitId = UnitId (fsLit cProjectUnitId) interactiveUnitId = UnitId (fsLit "interactive") thUnitId = UnitId (fsLit "template-haskell") @@ -625,8 +626,15 @@ wiredInUnitIds = , baseUnitId , rtsUnitId , thUnitId - , thisGhcUnitId ] + -- NB: ghc is no longer part of the wired-in units since its unit-id, given + -- by hadrian or cabal, is no longer overwritten and now matches both the + -- cProjectUnitId defined in build-time-generated module GHC.Version, and + -- the unit key. + -- + -- See also Note [About units], taking into consideration ghc is still a + -- wired-in unit but whose unit-id no longer needs special handling because + -- we take care that it matches the unit key. --------------------------------------------------------------------- -- Boot Modules ===================================== compiler/ghc.cabal.in ===================================== @@ -57,6 +57,12 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +-- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` +Flag hadrian-stage0 + Description: Enable if compiling the stage0 compiler with hadrian + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -136,9 +142,10 @@ Library Include-Dirs: . - -- We need to set the unit id to ghc (without a version number) - -- as it's magic. - GHC-Options: -this-unit-id ghc + if flag(hadrian-stage0) + -- We need to set the unit id to ghc (without a version number) + -- as it's magic. + GHC-Options: -this-unit-id ghc c-sources: cbits/cutils.c ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -533,6 +533,19 @@ generateVersionHs = do cProjectPatchLevel <- getSetting ProjectPatchLevel cProjectPatchLevel1 <- getSetting ProjectPatchLevel1 cProjectPatchLevel2 <- getSetting ProjectPatchLevel2 + cProjectVersionMunged <- getSetting ProjectVersionMunged + -- ROMES:TODO: First we attempt a fixed unit-id with version but without hash. + -- We now use a more informative unit-id for ghc. This same logic must be + -- done when passing -this-unit-id when building ghc (at stage0 one must + -- pass -this-unit-id ghc). + -- + -- It's crucial that the unit-id matches the unit-key -- ghc is no longer + -- part of the WiringMap, so we don't to go back and forth between the + -- unit-id and the unit-key, because we take care here that they are the same. + -- + -- One worry: How to guarantee this is the same when we install ghc with cabal + let cProjectUnitId = "ghc-" ++ cProjectVersionMunged + return $ unlines [ "module GHC.Version where" , "" @@ -555,6 +568,9 @@ generateVersionHs = do , "" , "cProjectPatchLevel2 :: String" , "cProjectPatchLevel2 = " ++ show cProjectPatchLevel2 + , "" + , "cProjectUnitId :: String" + , "cProjectUnitId = " ++ show cProjectUnitId ] -- | Generate @Platform/Host.hs@ files. ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -247,6 +247,16 @@ packageGhcArgs :: Args packageGhcArgs = do package <- getPackage ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) + -- ROMES: Until the boot compiler no longer needs ghc's + -- unit-id to be "ghc", the stage0 compiler must be built + -- with `-this-unit-id ghc`, while the wired-in unit-id of + -- ghc is correctly set to the unit-id we'll generate for + -- stage1 (set in generateVersionHs in Rules.Generate). + -- + -- However, we don't need to set the unit-id of "ghc" to "ghc" when + -- building stage0 because we have a flag in compiler/ghc.cabal.in that is + -- sets `-this-unit-id ghc` when hadrian is building stage0, which will + -- overwrite this one. pkgId <- expr $ pkgIdentifier package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -77,6 +77,11 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + -- ROMES: While the boot compiler is not updated wrt -this-unit-id + -- not being fixed to `ghc`, when building stage0, we must set + -- -this-unit-id to `ghc` because the boot compiler expects that. + -- We do it through a cabal flag in ghc.cabal + , stage0 ? arg "+hadrian-stage0" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] ===================================== testsuite/tests/driver/j-space/jspace.hs ===================================== @@ -2,6 +2,7 @@ module Main where import GHC import GHC.Driver.Monad +import GHC.Driver.Session import System.Environment import GHC.Driver.Env.Types import GHC.Profiling @@ -25,6 +26,9 @@ initGhcM xs = do let cmdOpts = ["-fforce-recomp"] ++ xs (df2, leftovers, _) <- parseDynamicFlags (hsc_logger session) df1 (map noLoc cmdOpts) setSessionDynFlags df2 + ghcUnitId <- case lookup "Project Unit Id" (compilerInfo df2) of + Nothing -> fail "failed to find ghc's unit-id in the compiler info" + Just ghcUnitId -> pure ghcUnitId ts <- mapM (\s -> guessTarget s Nothing Nothing) $ map unLoc leftovers setTargets ts _ <- load LoadAllTargets @@ -36,7 +40,7 @@ initGhcM xs = do liftIO $ do requestHeapCensus performGC - [ys] <- filter (isPrefixOf "ghc:GHC.Unit.Module.ModDetails.ModDetails") . lines <$> readFile "jspace.hp" + [ys] <- filter (isPrefixOf (ghcUnitId <> ":GHC.Unit.Module.ModDetails.ModDetails")) . lines <$> readFile "jspace.hp" let (n :: Int) = read (last (words ys)) -- The output should be 50 * 8 * word_size (i.e. 3200, or 1600 on 32-bit architectures): -- the test contains DEPTH + WIDTH + 2 = 50 modules J, H_0, .., H_DEPTH, W_1, .., W_WIDTH, ===================================== utils/count-deps/Main.hs ===================================== @@ -56,25 +56,28 @@ calcDeps modName libdir = logger <- getLogger (df, _, _) <- parseDynamicFlags logger df [noLoc "-package=ghc"] setSessionDynFlags df - env <- getSession - loop env Map.empty [mkModuleName modName] + case lookup "Project Unit Id" (compilerInfo df) of + Nothing -> fail "failed to find ghc's unit-id in the compiler info" + Just ghcUnitId -> do + env <- getSession + loop ghcUnitId env Map.empty [mkModuleName modName] where -- Source imports are only guaranteed to show up in the 'mi_deps' -- of modules that import them directly and don’t propagate -- transitively so we loop. - loop :: HscEnv -> Map.Map ModuleName [ModuleName] -> [ModuleName] -> Ghc (Map.Map ModuleName [ModuleName]) - loop env modules (m : ms) = + loop :: String -> HscEnv -> Map.Map ModuleName [ModuleName] -> [ModuleName] -> Ghc (Map.Map ModuleName [ModuleName]) + loop ghcUnitId env modules (m : ms) = if m `Map.member` modules - then loop env modules ms + then loop ghcUnitId env modules ms else do - mi <- liftIO $ hscGetModuleInterface env (mkModule m) + mi <- liftIO $ hscGetModuleInterface env (mkModule ghcUnitId m) let deps = modDeps mi modules <- return $ Map.insert m [] modules - loop env (Map.insert m deps modules) $ ms ++ filter (not . (`Map.member` modules)) deps - loop _ modules [] = return modules + loop ghcUnitId env (Map.insert m deps modules) $ ms ++ filter (not . (`Map.member` modules)) deps + loop _ _ modules [] = return modules - mkModule :: ModuleName -> Module - mkModule = Module (stringToUnit "ghc") + mkModule :: String -> ModuleName -> Module + mkModule ghcUnitId = Module (stringToUnit ghcUnitId) modDeps :: ModIface -> [ModuleName] modDeps mi = map (gwib_mod . snd) $ Set.toList $ dep_direct_mods (mi_deps mi) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f5444fdc215485cefd6f928746fce545c68beea7...0aa3abb8a6ab4315c9d4ea301bf09c9915f59778 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f5444fdc215485cefd6f928746fce545c68beea7...0aa3abb8a6ab4315c9d4ea301bf09c9915f59778 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 14 17:03:35 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 14 Mar 2023 13:03:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23116 Message-ID: <6410a8e7ee268_37e76bba820541824eb@gitlab.mail> Ben Gamari pushed new branch wip/T23116 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23116 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 14 20:24:08 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 14 Mar 2023 16:24:08 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Bug fixes Message-ID: <6410d7e8bd005_37e76bf140ff02125b2@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 2be09e53 by Simon Peyton Jones at 2023-03-14T20:23:53+00:00 Bug fixes - - - - - 3 changed files: - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/typecheck/should_fail/T12785b.stderr Changes: ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -2092,10 +2092,10 @@ checkTouchableTyVarEq ev lhs_tv rhs -- Normal case _other -> checkTyEqRhs flags rhs - flags | MetaTv { mtv_info = tv_info, mtv_tclvl = lvl } <- tcTyVarDetails lhs_tv + flags | MetaTv { mtv_info = tv_info, mtv_tclvl = tv_lvl } <- tcTyVarDetails lhs_tv = TEF { tef_foralls = isRuntimeUnkSkol lhs_tv - , tef_fam_app = TEFA_Break (break_wanted lvl) - , tef_unifying = Unifying tv_info lvl LC_Promote + , tef_fam_app = mkTEFA_Break ev (break_wanted tv_lvl) + , tef_unifying = Unifying tv_info tv_lvl LC_Promote , tef_lhs = TyVarLHS lhs_tv } | otherwise = pprPanic "checkTouchableTyVarEq" (ppr lhs_tv) @@ -2144,7 +2144,7 @@ checkTypeEq ev eq_rel lhs rhs given_flags = TEF { tef_lhs = lhs , tef_foralls = False , tef_unifying = NotUnifying eq_rel - , tef_fam_app = TEFA_Break break_given } + , tef_fam_app = mkTEFA_Break ev break_given } -- TEFA_Break used for: [G] a ~ Maybe (F a) -- or [W] F a ~ Maybe (F a) @@ -2175,6 +2175,14 @@ checkTypeEq ev eq_rel lhs rhs -- See Detail (7) of the Note cb_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin +mkTEFA_Break :: CtEvidence -> FamAppBreaker a -> TyEqFamApp a +-- See Detail (7) of Note [Type equality cycles] in GHC.Tc.Solver.Equality +mkTEFA_Break ev breaker + | CycleBreakerOrigin {} <- ctLocOrigin (ctEvLoc ev) + = TEFA_Recurse + | otherwise + = TEFA_Break breaker + ------------------------- -- | Fill in CycleBreakerTvs with the variables they stand for. -- See Note [Type equality cycles] in GHC.Tc.Solver.Canonical. ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -35,7 +35,7 @@ module GHC.Tc.Utils.Unify ( checkTyEqRhs, PuResult(..), failCheckWith, okCheckRefl, mapCheck, - TyEqFlags(..), TyEqFamApp(..), AreUnifying(..), LevelCheck(..), + TyEqFlags(..), TyEqFamApp(..), AreUnifying(..), LevelCheck(..), FamAppBreaker, stopPromoting, occursCheckTv ) where @@ -58,7 +58,7 @@ import GHC.Types.Name( Name, isSystemName ) import GHC.Core.Type import GHC.Core.TyCo.Rep import GHC.Core.TyCo.FVs( injectiveVarsOfType ) -import GHC.Core.TyCo.Ppr( debugPprType ) +import GHC.Core.TyCo.Ppr( debugPprType, pprTyVar ) import GHC.Core.TyCon import GHC.Core.Coercion import GHC.Core.Multiplicity @@ -2079,19 +2079,19 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 do { check_result <- uTypeCheckTouchableTyVarEq tv1 ty2 ; case check_result of { PuFail {} -> not_ok_so_defer ; - PuOK {} -> - do { co_k <- uType KindLevel kind_origin (typeKind ty2) (tyVarKind tv1) + PuOK ty2' _ -> + do { co_k <- uType KindLevel kind_origin (typeKind ty2') (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) - , ppr ty2 <+> dcolon <+> ppr (typeKind ty2) + , ppr ty2 <+> dcolon <+> ppr (typeKind ty2') , ppr (isReflCo co_k), ppr co_k ] ; if isReflCo co_k -- Only proceed if the kinds match -- NB: tv1 should still be unfilled, despite the kind unification - -- because tv1 is not free in ty2 (or, hence, in its kind) - then do { writeMetaTyVar tv1 ty2 - ; return (mkNomReflCo ty2) } + -- because tv1 is not free in ty2' (or, hence, in its kind) + then do { writeMetaTyVar tv1 ty2' + ; return (mkNomReflCo ty2') } else defer -- This cannot be solved now. See GHC.Tc.Solver.Canonical -- Note [Equalities with incompatible kinds] for how @@ -2525,19 +2525,23 @@ matchExpectedFunKind hs_ty n k = go n k * * ********************************************************************* -} -uTypeCheckTouchableTyVarEq :: TcTyVar -> TcType -> TcM (PuResult () ()) +uTypeCheckTouchableTyVarEq :: TcTyVar -> TcType -> TcM (PuResult () TcType) +-- The check may expand type synonyms to avoid an occurs check, +-- so we must use the return type uTypeCheckTouchableTyVarEq lhs_tv rhs - = do { check_result <- checkTyEqRhs flags rhs + = do { traceTc "uTypeCheckTouchableTyVarEq {" (pprTyVar lhs_tv $$ ppr rhs) + ; check_result <- checkTyEqRhs flags rhs :: TcM (PuResult () Reduction) + ; traceTc "uTypeCheckTouchableTyVarEq }" (ppr check_result) ; case check_result of PuFail reason -> return (PuFail reason) PuOK redn _ -> assertPpr (isReflCo (reductionCoercion redn)) (ppr lhs_tv $$ ppr rhs $$ ppr redn) $ - return (PuOK () emptyBag) } + return (PuOK (reductionReducedType redn) emptyBag) } where - flags | MetaTv { mtv_info = tv_info, mtv_tclvl = lvl } <- tcTyVarDetails lhs_tv + flags | MetaTv { mtv_info = tv_info, mtv_tclvl = tv_lvl } <- tcTyVarDetails lhs_tv = TEF { tef_foralls = False , tef_fam_app = TEFA_Fail - , tef_unifying = Unifying tv_info lvl LC_None + , tef_unifying = Unifying tv_info tv_lvl LC_None , tef_lhs = TyVarLHS lhs_tv } | otherwise = pprPanic "uTypeCheckTouchableTyVarEq" (ppr lhs_tv) @@ -2816,12 +2820,12 @@ checkTyConApp flags tc_app tc tys , Just ty' <- coreView tc_app -- Only synonyms and type families reply = checkTyEqRhs flags ty' -- False to isFamFreeTyCon + | not (isTauTyCon tc || tef_foralls flags) + = failCheckWith impredicativeProblem + | otherwise -- Recurse on arguments = do { tys_res <- mapCheck (checkTyEqRhs flags) tys - ; if | not (isTauTyCon tc || tef_foralls flags) - -> failCheckWith impredicativeProblem - | otherwise - -> return (mkTyConAppRedn Nominal tc <$> tys_res) } + ; return (mkTyConAppRedn Nominal tc <$> tys_res) } ------------------- checkFamApp :: TyEqFlags a @@ -2870,7 +2874,7 @@ checkTyVar flags occ_tv --------------------- check_tv (NotUnifying eq_rel) lhs_tv - | lhs_tv == occ_tv + | occursCheckTv lhs_tv occ_tv = failCheckWith (occursProblem eq_rel) | otherwise = success @@ -2888,6 +2892,9 @@ checkTyVar flags occ_tv check_unif :: MetaInfo -> TcLevel -> LevelCheck -> TcTyVar -> TcM (PuResult a Reduction) check_unif lhs_tv_info lhs_tv_lvl prom lhs_tv + | lhs_tv == occ_tv -- We check the kind of occ_tv later, in checkFreeVars + = failCheckWith insolubleOccursProblem + | isConcreteInfo lhs_tv_info , not (isConcreteTyVar occ_tv) = if can_make_concrete occ_tv ===================================== testsuite/tests/typecheck/should_fail/T12785b.stderr ===================================== @@ -1,6 +1,6 @@ T12785b.hs:30:65: error: [GHC-25897] - • Could not deduce ‘Payload (S n) (Payload n s1) ~ s’ + • Could not deduce ‘s ~ Payload (S n) (Payload n s1)’ arising from a use of ‘SBranchX’ from the context: m ~ S n bound by a pattern with constructor: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2be09e532f1d19f1610c01b5cd3ad172e5c845a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2be09e532f1d19f1610c01b5cd3ad172e5c845a8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 08:17:28 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 15 Mar 2023 04:17:28 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] More bug fixes Message-ID: <64117f18411ae_37e76b1a5abc242417a8@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 7dcf3659 by Simon Peyton Jones at 2023-03-14T23:53:09+00:00 More bug fixes - - - - - 5 changed files: - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -847,8 +847,9 @@ injectiveVarsOfType look_under_tfs = go go CoercionTy{} = emptyFV go_tc tc tys - | isFamilyTyCon tc - = if | look_under_tfs, Injective flags <- tyConInjectivityInfo tc + | isTypeFamilyTyCon tc + = if | look_under_tfs + , Injective flags <- tyConInjectivityInfo tc -> mapUnionFV go $ filterByList (flags ++ repeat True) tys -- Oversaturated arguments to a tycon are ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -634,8 +634,8 @@ can_eq_newtype_nc ev swapped ty1 ((gres, co1), ty1') ty2 ps_ty2 ; let redn1 = mkReduction co1 ty1' ; new_ev <- rewriteEqEvidence emptyRewriterSet ev' swapped - redn1 - (mkReflRedn Representational ps_ty2) + redn1 (mkReflRedn Representational ps_ty2) + ; can_eq_nc False new_ev ReprEq ty1' ty1' ty2 ps_ty2 } --------- @@ -1713,18 +1713,29 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs , TyVarLHS tv <- lhs = do { given_eq_lvl <- getInnermostGivenEqLevel ; if not (touchabilityTest given_eq_lvl tv rhs) - then canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs + then if | Just can_rhs <- canTyFamEqLHS_maybe rhs + -> swapAndFinish ev eq_rel swapped tv can_rhs + | otherwise + -> canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs else -- We have a touchable unification variable on the left do { check_result <- checkTouchableTyVarEq ev tv rhs ; case check_result of { - PuFail reason -> cantMakeCanonical reason ev eq_rel swapped lhs rhs ; - PuOK redn _ -> + PuFail reason + | Just can_rhs <- canTyFamEqLHS_maybe rhs + -> swapAndFinish ev eq_rel swapped tv can_rhs + | otherwise + -> tryIrredInstead reason ev eq_rel swapped lhs rhs ; + + PuOK rhs_redn _ -> -- Success: we can solve by unification - do { let tv_ty = mkTyVarTy tv - final_rhs = reductionReducedType redn + do { new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped + (mkReflRedn Nominal (mkTyVarTy tv)) rhs_redn + + ; let tv_ty = mkTyVarTy tv + final_rhs = reductionReducedType rhs_redn tv_lvl = tcTyVarLevel tv ; traceTcS "Sneaky unification:" $ @@ -1738,7 +1749,7 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs -- Provide Refl evidence for the constraint -- Ignore 'swapped' because it's Refl! - ; setEvBindIfWanted ev IsCoherent $ + ; setEvBindIfWanted new_ev IsCoherent $ evCoercion (mkNomReflCo final_rhs) -- Set the unification flag if we have done outer unifications @@ -1750,15 +1761,15 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs -- Kick out any constraints that can now be rewritten ; n_kicked <- kickOutAfterUnification tv - ; return (Stop ev (text "Solved by unification" <+> pprKicked n_kicked)) }}}} + ; return (Stop new_ev (text "Solved by unification" <+> pprKicked n_kicked)) }}}} -- Otherwise unification is off the table | otherwise = canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs - --------------------------- -- Unification is off the table +-- Here we never have TyVarLHS ~ TyFamLHS (it is always the other way) canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs = do { -- Do checkTypeEq to guarantee (TyEq:OC), (TyEq:F) -- Must do the occurs check even on tyvar/tyvar equalities, @@ -1766,7 +1777,7 @@ canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs ; check_result <- checkTypeEq ev eq_rel lhs rhs ; case check_result of { - PuFail reason -> cantMakeCanonical reason ev eq_rel swapped lhs rhs ; + PuFail reason -> tryIrredInstead reason ev eq_rel swapped lhs rhs ; PuOK rhs_redn _ -> do { new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped @@ -1777,29 +1788,30 @@ canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs , eq_rhs = reductionReducedType rhs_redn }) }}} ---------------------- -cantMakeCanonical :: CheckTyEqResult -> CtEvidence -> EqRel -> SwapFlag - -> CanEqLHS -> TcType - -> TcS (StopOrContinue Ct) -cantMakeCanonical reason ev eq_rel swapped lhs rhs - | TyVarLHS tv <- lhs - , Just (tc,tys) <- splitTyConApp_maybe rhs - , isFamilyTyCon tc - , let lhs_ty = mkTyVarTy tv - = -- Flip (a ~ F tys) to (F tys ~ a) - do { new_ev <- rewriteEqEvidence emptyRewriterSet ev (flipSwap swapped) - (mkReflRedn role rhs) (mkReflRedn role lhs_ty) +swapAndFinish :: CtEvidence -> EqRel -> SwapFlag + -> TcTyVar -> CanEqLHS -- a ~ F tys + -> TcS (StopOrContinue Ct) +-- We have an equality a ~ F tys, and want to flip it to +-- (F tys ~ a), whereupon it is canonical +swapAndFinish ev eq_rel swapped lhs_tv can_rhs + = do { let lhs_ty = mkTyVarTy lhs_tv + ; new_ev <- rewriteEqEvidence emptyRewriterSet ev (flipSwap swapped) + (mkReflRedn role (canEqLHSType can_rhs)) + (mkReflRedn role lhs_ty) ; interactEq (EqCt { eq_ev = new_ev, eq_eq_rel = eq_rel - , eq_lhs = TyFamLHS tc tys - , eq_rhs = lhs_ty }) } - - | otherwise - = do { traceTcS "cantMakeCanonical" (ppr lhs $$ ppr rhs) - ; new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped - (mkReflRedn role (canEqLHSType lhs)) (mkReflRedn role rhs) - ; solveIrredEquality (NonCanonicalReason reason) new_ev } + , eq_lhs = can_rhs, eq_rhs = lhs_ty }) } where role = eqRelRole eq_rel +---------------------- +tryIrredInstead :: CheckTyEqResult -> CtEvidence -> EqRel -> SwapFlag + -> CanEqLHS -> TcType -> TcS (StopOrContinue Ct) +-- We have a non-canonical equality +-- No need to swap; just hand it off +tryIrredInstead reason ev _eq_rel _swapped lhs rhs + = do { traceTcS "cantMakeCanonical" (ppr reason $$ ppr lhs $$ ppr rhs) + ; solveIrredEquality (NonCanonicalReason reason) ev } + ----------------------- -- | Solve a reflexive equality constraint canEqReflexive :: CtEvidence -- ty ~ ty ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -2073,33 +2073,34 @@ checkTouchableTyVarEq -- with extra wanteds 'cts' -- If it returns (PuFail reason) we can't unify, and the reason explains why. checkTouchableTyVarEq ev lhs_tv rhs - = do { traceTcS "checkTouchableTyVarEq" (ppr lhs_tv $$ ppr rhs) - ; check_result <- wrapTcS check_rhs - ; traceTcS "checkTouchableTyVarEq 2" (ppr lhs_tv $$ ppr check_result) + = do { traceTcS "checkTouchableTyVarEq {" (ppr lhs_tv $$ ppr rhs) + ; check_result <- wrapTcS (check_rhs rhs) + ; traceTcS "checkTouchableTyVarEq }" (ppr lhs_tv $$ ppr check_result) ; case check_result of PuFail reason -> return (PuFail reason) PuOK redn cts -> do { emitWork (bagToList cts) ; return (pure redn) } } where - check_rhs = case splitTyConApp_maybe rhs of - Just (tc, tys) | isTypeFamilyTyCon tc - , not (isConcreteTyVar lhs_tv) - -> -- Crucial special case for alpha ~ F tys - -- We don't want to flatten that (F tys)! - do { tys_res <- mapCheck (checkTyEqRhs simple_flags) tys - ; return (mkTyConAppRedn Nominal tc <$> tys_res) } + check_rhs rhs + -- Crucial special case for alpha ~ F tys + -- We don't want to flatten that (F tys)! + | Just (tc,tys) <- splitTyConApp_maybe rhs + , isTypeFamilyTyCon tc + , not (isConcreteTyVar lhs_tv) + = do { tys_res <- mapCheck (checkTyEqRhs arg_flags) tys + ; return (mkTyConAppRedn Nominal tc <$> tys_res) } - -- Normal case - _other -> checkTyEqRhs flags rhs + | otherwise = checkTyEqRhs flags rhs flags | MetaTv { mtv_info = tv_info, mtv_tclvl = tv_lvl } <- tcTyVarDetails lhs_tv = TEF { tef_foralls = isRuntimeUnkSkol lhs_tv , tef_fam_app = mkTEFA_Break ev (break_wanted tv_lvl) , tef_unifying = Unifying tv_info tv_lvl LC_Promote - , tef_lhs = TyVarLHS lhs_tv } + , tef_lhs = TyVarLHS lhs_tv + , tef_occurs = cteInsolubleOccurs } | otherwise = pprPanic "checkTouchableTyVarEq" (ppr lhs_tv) - simple_flags = stopPromoting flags + arg_flags = famAppArgFlags flags break_wanted lhs_tv_lvl fam_app -- Occurs check or skolem escape; so flatten = do { new_tv_ty <- TcM.newMetaTyVarTyAtLevel lhs_tv_lvl (typeKind fam_app) @@ -2125,7 +2126,10 @@ checkTypeEq :: CtEvidence -> EqRel -> CanEqLHS -> TcType -- For Wanteds, don't bother checkTypeEq ev eq_rel lhs rhs | isGiven ev - = do { check_result <- wrapTcS (checkTyEqRhs given_flags rhs) + = do { traceTcS "checkTypeEq {" (vcat [ text "lhs:" <+> ppr lhs + , text "rhs:" <+> ppr rhs ]) + ; check_result <- wrapTcS (checkTyEqRhs given_flags rhs) + ; traceTcS "checkTypeEq }" (ppr check_result) ; case check_result of PuFail reason -> return (PuFail reason) PuOK redn prs -> do { let prs_list = bagToList prs @@ -2143,19 +2147,25 @@ checkTypeEq ev eq_rel lhs rhs where given_flags = TEF { tef_lhs = lhs , tef_foralls = False - , tef_unifying = NotUnifying eq_rel - , tef_fam_app = mkTEFA_Break ev break_given } + , tef_unifying = NotUnifying + , tef_fam_app = mkTEFA_Break ev break_given + , tef_occurs = occ_prob } -- TEFA_Break used for: [G] a ~ Maybe (F a) -- or [W] F a ~ Maybe (F a) wanted_flags = TEF { tef_lhs = lhs , tef_foralls = False - , tef_unifying = NotUnifying eq_rel - , tef_fam_app = TEFA_Recurse } + , tef_unifying = NotUnifying + , tef_fam_app = TEFA_Recurse + , tef_occurs = occ_prob } -- TEFA_Recurse: no point in TEFA_Break, because we would just make -- [W] beta[tau] ~ F ty (beta fresh) -- and would then unify beta in the next step. Infinite loop! + occ_prob = case eq_rel of + NomEq -> cteInsolubleOccurs + ReprEq -> cteSolubleOccurs + break_given :: TcType -> TcM (PuResult (TcTyVar,TcType) Reduction) break_given fam_app = do { new_tv <- TcM.newCycleBreakerTyVar (typeKind fam_app) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -43,8 +43,8 @@ module GHC.Tc.Types.Constraint ( cterHasNoProblem, cterHasProblem, cterHasOnlyProblem, cterRemoveProblem, cterHasOccursCheck, cterFromKind, - CanEqLHS(..), canEqLHS_maybe, canEqLHSKind, canEqLHSType, - eqCanEqLHS, + CanEqLHS(..), canEqLHS_maybe, canTyFamEqLHS_maybe, + canEqLHSKind, canEqLHSType, eqCanEqLHS, Hole(..), HoleSort(..), isOutOfScopeHole, DelayedError(..), NotConcreteError(..), @@ -761,6 +761,11 @@ canEqLHS_maybe xi | Just tv <- getTyVar_maybe xi = Just $ TyVarLHS tv + | otherwise + = canTyFamEqLHS_maybe xi + +canTyFamEqLHS_maybe :: Xi -> Maybe CanEqLHS +canTyFamEqLHS_maybe xi | Just (tc, args) <- tcSplitTyConApp_maybe xi , isTypeFamilyTyCon tc , args `lengthIs` tyConArity tc ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -36,7 +36,7 @@ module GHC.Tc.Utils.Unify ( checkTyEqRhs, PuResult(..), failCheckWith, okCheckRefl, mapCheck, TyEqFlags(..), TyEqFamApp(..), AreUnifying(..), LevelCheck(..), FamAppBreaker, - stopPromoting, occursCheckTv + famAppArgFlags, occursCheckTv ) where import GHC.Prelude @@ -63,7 +63,6 @@ import GHC.Core.TyCon import GHC.Core.Coercion import GHC.Core.Multiplicity import GHC.Core.Reduction -import GHC.Core.Predicate( EqRel(..) ) import qualified GHC.LanguageExtensions as LangExt @@ -2542,7 +2541,8 @@ uTypeCheckTouchableTyVarEq lhs_tv rhs = TEF { tef_foralls = False , tef_fam_app = TEFA_Fail , tef_unifying = Unifying tv_info tv_lvl LC_None - , tef_lhs = TyVarLHS lhs_tv } + , tef_lhs = TyVarLHS lhs_tv + , tef_occurs = cteInsolubleOccurs } | otherwise = pprPanic "uTypeCheckTouchableTyVarEq" (ppr lhs_tv) -- TEFA_Fail: See Note [Prevent unification with type families] @@ -2692,7 +2692,8 @@ data TyEqFlags a = TEF { tef_foralls :: Bool -- Allow foralls , tef_lhs :: CanEqLHS -- LHS of the constraint , tef_unifying :: AreUnifying -- Always NotUnifying if tef_lhs is TyFamLHS - , tef_fam_app :: TyEqFamApp a } + , tef_fam_app :: TyEqFamApp a + , tef_occurs :: CheckTyEqProblem } -- Soluble or insoluble occurs check -- What to do for a type-family application data TyEqFamApp a @@ -2708,7 +2709,6 @@ data AreUnifying LevelCheck | NotUnifying -- Not attempting to unify - EqRel -- Role of equality (unifying is always NomEq) data LevelCheck = LC_None -- Level check not needed: we should never encounter a @@ -2719,17 +2719,20 @@ data LevelCheck | LC_Promote -- Do a level check against this level; if it fails on a -- unification variable, promote it -stopPromoting :: TyEqFlags a -> TyEqFlags a +famAppArgFlags :: TyEqFlags a -> TyEqFlags a +-- Adjust the flags when going undter a type family -- Only the outer family application gets the loop-breaker treatment -- Ditto tyvar promotion. E.g. -- [W] alpha[2] ~ Maybe (F beta[3]) -- Do not promote beta[3]; instead promote (F beta[3]) -stopPromoting flags@(TEF { tef_unifying = unifying }) - = flags { tef_fam_app = TEFA_Recurse, tef_unifying = unifying' } +famAppArgFlags flags@(TEF { tef_unifying = unifying }) + = flags { tef_fam_app = TEFA_Recurse + , tef_unifying = zap_promotion unifying + , tef_occurs = cteSolubleOccurs } + -- tef_occurs: under a type family, an occurs check is not definitely-insoluble where - unifying' = case unifying of - Unifying info lvl LC_Promote -> Unifying info lvl LC_Check - _ -> unifying + zap_promotion (Unifying info lvl LC_Promote) = Unifying info lvl LC_Check + zap_promotion unifying = unifying type FamAppBreaker a = TcType -> TcM (PuResult a Reduction) -- Given a family-application ty, return a Reduction :: ty ~ cvb @@ -2777,7 +2780,9 @@ checkCo :: TyEqFlags a -> Coercion -> TcM (PuResult a Coercion) checkCo (TEF { tef_lhs = TyFamLHS {} }) co = return (PuOK co emptyBag) -checkCo (TEF { tef_lhs = TyVarLHS lhs_tv, tef_unifying = unifying }) co +checkCo (TEF { tef_lhs = TyVarLHS lhs_tv + , tef_unifying = unifying + , tef_occurs = occ_prob }) co -- Check for coercion holes, if unifying -- See (COERCION-HOLE) in Note [Unification preconditions] | Unifying {} <- unifying @@ -2786,14 +2791,14 @@ checkCo (TEF { tef_lhs = TyVarLHS lhs_tv, tef_unifying = unifying }) co -- Occurs check (can promote) | Unifying _ lhs_tv_lvl LC_Promote <- unifying - = do { reason <- checkFreeVars lhs_tv lhs_tv_lvl (tyCoVarsOfCo co) + = do { reason <- checkFreeVars occ_prob lhs_tv lhs_tv_lvl (tyCoVarsOfCo co) ; if cterHasNoProblem reason then return (pure co) else failCheckWith reason } -- Occurs check (no promotion) | lhs_tv `elemVarSet` tyCoVarsOfCo co - = failCheckWith insolubleOccursProblem + = failCheckWith (cteProblem occ_prob) | otherwise = return (PuOK co emptyBag) @@ -2831,51 +2836,52 @@ checkTyConApp flags tc_app tc tys checkFamApp :: TyEqFlags a -> TcType -> TyCon -> [TcType] -- Saturated family application -> TcM (PuResult a Reduction) -checkFamApp flags fam_app tc tys - | Unifying lhs_info _ _ <- tef_unifying flags +checkFamApp flags@(TEF { tef_unifying = unifying, tef_occurs = occ_prob + , tef_fam_app = fam_app_flag, tef_lhs = lhs }) + fam_app tc tys + | Unifying lhs_info _ _ <- unifying , isConcreteInfo lhs_info = failCheckWith (cteProblem cteConcrete) | otherwise - = case tef_fam_app flags of + = case fam_app_flag of TEFA_Fail -> failCheckWith (cteProblem cteTypeFamily) TEFA_Recurse - | TyFamLHS lhs_tc lhs_tys <- tef_lhs flags + | TyFamLHS lhs_tc lhs_tys <- lhs , tcEqTyConApps lhs_tc lhs_tys tc tys - , let eq_rel = case tef_unifying flags of - Unifying {} -> NomEq - NotUnifying eq_rel -> eq_rel - -> failCheckWith (occursProblem eq_rel) + -> failCheckWith (cteProblem occ_prob) | otherwise - -> do { tys_res <- mapCheck (checkTyEqRhs flags) tys + -> do { tys_res <- mapCheck (checkTyEqRhs arg_flags) tys ; return (mkTyConAppRedn Nominal tc <$> tys_res) } TEFA_Break breaker - | TyFamLHS lhs_tc lhs_tys <- tef_lhs flags + | TyFamLHS lhs_tc lhs_tys <- lhs , tcEqTyConApps lhs_tc lhs_tys tc tys -> breaker fam_app | otherwise - -> do { tys_res <- mapCheck (checkTyEqRhs (stopPromoting flags)) tys + -> do { tys_res <- mapCheck (checkTyEqRhs arg_flags) tys ; case tys_res of PuOK redns cts -> return (PuOK (mkTyConAppRedn Nominal tc redns) cts) PuFail {} -> breaker fam_app } + where + arg_flags = famAppArgFlags flags ------------------- checkTyVar :: forall a. TyEqFlags a -> TcTyVar -> TcM (PuResult a Reduction) -checkTyVar flags occ_tv - = case tef_lhs flags of +checkTyVar (TEF { tef_lhs = lhs, tef_unifying = unifying, tef_occurs = occ_prob }) occ_tv + = case lhs of TyFamLHS {} -> success -- Nothing to do if the LHS is a type-family - TyVarLHS lhs_tv -> check_tv (tef_unifying flags) lhs_tv + TyVarLHS lhs_tv -> check_tv unifying lhs_tv where lvl_occ = tcTyVarLevel occ_tv success = okCheckRefl (mkTyVarTy occ_tv) --------------------- - check_tv (NotUnifying eq_rel) lhs_tv + check_tv NotUnifying lhs_tv | occursCheckTv lhs_tv occ_tv - = failCheckWith (occursProblem eq_rel) + = failCheckWith (cteProblem occ_prob) | otherwise = success @@ -2893,7 +2899,7 @@ checkTyVar flags occ_tv -> TcTyVar -> TcM (PuResult a Reduction) check_unif lhs_tv_info lhs_tv_lvl prom lhs_tv | lhs_tv == occ_tv -- We check the kind of occ_tv later, in checkFreeVars - = failCheckWith insolubleOccursProblem + = failCheckWith (cteProblem occ_prob) | isConcreteInfo lhs_tv_info , not (isConcreteTyVar occ_tv) @@ -2929,7 +2935,7 @@ checkTyVar flags occ_tv new_lvl = lhs_tv_lvl `minTcLevel` lvl_occ -- c[conc,3] ~ p[tau,2]: want to clone p:=p'[conc,2] -- c[tau,2] ~ p[tau,3]: want to clone p:=p'[tau,2] - ; reason <- checkFreeVars lhs_tv lhs_tv_lvl (tyCoVarsOfType (tyVarKind occ_tv)) + ; reason <- checkFreeVars occ_prob lhs_tv lhs_tv_lvl (tyCoVarsOfType (tyVarKind occ_tv)) ; if cterHasNoProblem reason -- Successfully promoted then do { new_tv_ty <- promote_meta_tyvar new_info new_lvl occ_tv ; okCheckRefl new_tv_ty } @@ -2937,17 +2943,19 @@ checkTyVar flags occ_tv | otherwise = pprPanic "promote" (ppr occ_tv) ------------------------- -checkFreeVars :: TcTyVar -> TcLevel -> TyCoVarSet -> TcM CheckTyEqResult +checkFreeVars :: CheckTyEqProblem -- Occurs check problem + -> TcTyVar -> TcLevel + -> TyCoVarSet -> TcM CheckTyEqResult -- Check this set of TyCoVars for -- (a) occurs check -- (b) promote if necessary, or report skolem escape -checkFreeVars lhs_tv lhs_tv_lvl vs +checkFreeVars occ_prob lhs_tv lhs_tv_lvl vs = do { oks <- mapM do_one (nonDetEltsUniqSet vs) ; return (mconcat oks) } where do_one :: TyCoVar -> TcM CheckTyEqResult do_one v | isCoVar v = return cteOK - | lhs_tv == v = return insolubleOccursProblem + | lhs_tv == v = return (cteProblem occ_prob) | no_promotion = return cteOK | not (isMetaTyVar v) = return (cteProblem cteSkolemEscape) | otherwise = promote_one v View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7dcf3659e1338d0819eaca026c88bf4990485251 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7dcf3659e1338d0819eaca026c88bf4990485251 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 09:29:55 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 15 Mar 2023 05:29:55 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Minor fixes Message-ID: <64119013d5b48_37e76b1b814ab425641b@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 42e00f60 by Simon Peyton Jones at 2023-03-15T09:30:37+00:00 Minor fixes - - - - - 7 changed files: - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/polykinds/T18451a.hs - − testsuite/tests/polykinds/T18451b.hs - − testsuite/tests/polykinds/T18451b.stderr - testsuite/tests/polykinds/T9017.stderr - testsuite/tests/polykinds/all.T - testsuite/tests/rep-poly/RepPolyBackpack1.stderr Changes: ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2645,6 +2645,24 @@ Forall check Fail with ForAllReason +Note [Forgetful synonyms in checkTyConApp] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + type S a b = b -- Forgets 'a' + + [W] alpha[2] ~ Maybe (S beta[4] gamma[2]) + +We don't want to promote beta to level 2; rather, we should +expand the synonym. (Currently, in checkTypeEqRhs promotion +is irrevocable, by side effect.) + +To avoid this risk we eagerly expand forgetful synonyms. +This also means we won't get an occurs check in + a ~ S a b + +The annoyance is that we might expand the synonym unnecessarily, +something we generally try to avoid. But for now, this seems +simple. -} data PuResult a b = PuFail CheckTyEqResult @@ -2807,7 +2825,8 @@ checkCo (TEF { tef_lhs = TyVarLHS lhs_tv checkTyConApp :: TyEqFlags a -> TcType -> TyCon -> [TcType] -> TcM (PuResult a Reduction) -checkTyConApp flags tc_app tc tys +checkTyConApp flags@(TEF { tef_unifying = unifying, tef_foralls = foralls_ok }) + tc_app tc tys | isTypeFamilyTyCon tc , let arity = tyConArity tc = if tys `lengthIs` arity @@ -2821,13 +2840,18 @@ checkTyConApp flags tc_app tc tys | not (isFamFreeTyCon tc) || isForgetfulSynTyCon tc -- e.g. S a where type S a = F [a] -- or type S a = Int - -- ToDo: explain why + -- See Note [Forgetful synonyms in checkTyConApp] , Just ty' <- coreView tc_app -- Only synonyms and type families reply = checkTyEqRhs flags ty' -- False to isFamFreeTyCon - | not (isTauTyCon tc || tef_foralls flags) + | not (isTauTyCon tc || foralls_ok) = failCheckWith impredicativeProblem + | Unifying info _ _ <- unifying + , isConcreteInfo info + , not (isConcreteTyCon tc) + = failCheckWith (cteProblem cteConcrete) + | otherwise -- Recurse on arguments = do { tys_res <- mapCheck (checkTyEqRhs flags) tys ; return (mkTyConAppRedn Nominal tc <$> tys_res) } @@ -2898,9 +2922,6 @@ checkTyVar (TEF { tef_lhs = lhs, tef_unifying = unifying, tef_occurs = occ_prob check_unif :: MetaInfo -> TcLevel -> LevelCheck -> TcTyVar -> TcM (PuResult a Reduction) check_unif lhs_tv_info lhs_tv_lvl prom lhs_tv - | lhs_tv == occ_tv -- We check the kind of occ_tv later, in checkFreeVars - = failCheckWith (cteProblem occ_prob) - | isConcreteInfo lhs_tv_info , not (isConcreteTyVar occ_tv) = if can_make_concrete occ_tv @@ -2915,6 +2936,11 @@ checkTyVar (TEF { tef_lhs = lhs, tef_unifying = unifying, tef_occurs = occ_prob | isSkolemTyVar occ_tv -> failCheckWith (cteProblem cteSkolemEscape) | otherwise -> promote lhs_tv lhs_tv_info lhs_tv_lvl + -- Do this after checking for promotion, because promotion + -- also looks at the free vars of occ_tv; avoid duplication. + | occursCheckTv lhs_tv occ_tv + = failCheckWith (cteProblem occ_prob) + | otherwise = success ===================================== testsuite/tests/polykinds/T18451a.hs ===================================== @@ -10,3 +10,12 @@ type Const a b = a foo :: forall a b (c :: Const Type b). Proxy '[a, c] foo = error "ruk" + +-- We infer a :: k0, k0 ~ Const Type b +-- And Const is forgetful, so we expand it in the RHS of unifications; +-- so we end up with a :: Type. So the above is fine. +-- +-- This is a change (March 2023); previously we didn't expand the +-- synonym, and hence failed. +-- +-- See Note [Forgetful synonyms in checkTyConApp] in GHC.Tc.Utils.Unify ===================================== testsuite/tests/polykinds/T18451b.hs deleted ===================================== @@ -1,12 +0,0 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE DataKinds #-} -module Bug where - -import Data.Kind -import Data.Proxy - -type Const a b = a - -foo :: forall a b (c :: Const Type b). Proxy '[a, c] -foo = error "ruk" ===================================== testsuite/tests/polykinds/T18451b.stderr deleted ===================================== @@ -1,7 +0,0 @@ - -T18451b.hs:11:15: error: [GHC-97739] - • These kind and type variables: a b (c :: Const Type b) - are out of dependency order. Perhaps try this ordering: - (b :: k) (a :: Const (*) b) (c :: Const (*) b) - • In the type signature: - foo :: forall a b (c :: Const Type b). Proxy '[a, c] ===================================== testsuite/tests/polykinds/T9017.stderr ===================================== @@ -1,12 +1,12 @@ T9017.hs:8:7: error: [GHC-25897] - • Couldn't match kind ‘k2’ with ‘*’ + • Couldn't match kind ‘k1’ with ‘*’ When matching types a0 :: * -> * -> * a :: k1 -> k2 -> * Expected: a b (m b) Actual: a0 b0 (m0 b0) - ‘k2’ is a rigid type variable bound by + ‘k1’ is a rigid type variable bound by the type signature for: foo :: forall {k1} {k2} (a :: k1 -> k2 -> *) (b :: k1) (m :: k1 -> k2). ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -225,8 +225,7 @@ test('T17841', normal, compile_fail, ['']) test('T17963', normal, compile_fail, ['']) test('T18300', normal, compile_fail, ['']) test('T18451', normal, compile_fail, ['']) -test('T18451a', normal, compile_fail, ['']) -test('T18451b', normal, compile_fail, ['']) +test('T18451a', normal, compile, ['']) test('NestedProxies', normal, compile, ['']) test('T18522-ppr', normal, ghci_script, ['T18522-ppr.script']) test('T18855', normal, compile, ['']) ===================================== testsuite/tests/rep-poly/RepPolyBackpack1.stderr ===================================== @@ -1,9 +1,9 @@ [1 of 1] Processing number-unknown - [1 of 2] Compiling NumberUnknown[sig] ( number-unknown\NumberUnknown.hsig, nothing ) - [2 of 2] Compiling NumberStuff ( number-unknown\NumberStuff.hs, nothing ) + [1 of 2] Compiling NumberUnknown[sig] ( number-unknown/NumberUnknown.hsig, nothing ) + [2 of 2] Compiling NumberStuff ( number-unknown/NumberStuff.hs, nothing ) RepPolyBackpack1.bkp:17:5: error: [GHC-55287] - The second pattern in the equation for ‘funcA’ + The first pattern in the equation for ‘funcA’ does not have a fixed runtime representation. Its type is: Number l :: TYPE (Rep l) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42e00f605c893f147a1c4bccdcca942f597f97bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42e00f605c893f147a1c4bccdcca942f597f97bc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 09:45:12 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 15 Mar 2023 05:45:12 -0400 Subject: [Git][ghc/ghc][wip/T23051] 70 commits: Add `Data.Functor.unzip` Message-ID: <641193a867f78_37e76b1bde342c25688@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23051 at Glasgow Haskell Compiler / GHC Commits: fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - d998338c by Simon Peyton Jones at 2023-03-15T09:42:37+00:00 Comments and tc-trace only Be more careful about quantification This MR is driven by #23051. It does several things: * Never quantify over concrete type variables An extra guard in GHC.Tc.Utils.TcMType.collect_cand_qtvs * Never quantify over variables free in the kind of the type(s) being generalised. This is done in GHC.Tc.Solver.decideMonoTyVars, by adding `kind_vars` to `mono_tvs`. * When generalising a term in tcSimplifyInfer, move the promotion of `mono_tyvars` from `defaultTyVarsAndSimplify` to `decideMonoTyVars`. This is a no-op; just tidies up the code. * Get rid of the un-motivated (and I think unnecessary) blah about SkolemTv in collect_cand_qtvs. Needs documentation etc. Currently wanting this MR for CI. - - - - - c4484cef by Simon Peyton Jones at 2023-03-15T09:42:37+00:00 Rename decideMonoTyVars to decidePromotedTyVars - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Utils/TmpFs.hs - hadrian/doc/user-settings.md - hadrian/src/Expression.hs - hadrian/src/Flavour.hs - hadrian/src/Oracles/Flavour.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Quick.hs - hadrian/src/Settings/Packages.hs - libraries/Win32 - libraries/base/Data/Functor.hs - libraries/base/Debug/Trace.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0279d413f08d50566d942e6960e73cbd06037723...c4484cef7aba406331eaad0009d163883eec4690 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0279d413f08d50566d942e6960e73cbd06037723...c4484cef7aba406331eaad0009d163883eec4690 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 11:06:17 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 15 Mar 2023 07:06:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/interface-loading-errs Message-ID: <6411a6a9eb615_37e76b1d1372082629c2@gitlab.mail> Matthew Pickering pushed new branch wip/interface-loading-errs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/interface-loading-errs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 11:13:23 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 15 Mar 2023 07:13:23 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Fix isConcreteTyCon Message-ID: <6411a853d85c7_37e76b1d54dd74265012@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: a9ee8966 by Simon Peyton Jones at 2023-03-15T11:14:38+00:00 Fix isConcreteTyCon Adds a synIsConcrete to SynonymTyCon - - - - - 2 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -833,11 +833,15 @@ data TyConDetails = -- any type synonym families (data families -- are fine), again after expanding any -- nested synonyms - synIsForgetful :: Bool -- True <= at least one argument is not mentioned + + synIsForgetful :: Bool, -- True <= at least one argument is not mentioned -- in the RHS (or is mentioned only under -- forgetful synonyms) -- Test is conservative, so True does not guarantee -- forgetfulness. + + synIsConcrete :: Bool -- True <= If 'tys' are concrete then the expansion + -- of (S tys) is concrete } -- | Represents families (both type and data) @@ -1873,13 +1877,17 @@ mkPrimTyCon name binders res_kind roles -- | Create a type synonym 'TyCon' mkSynonymTyCon :: Name -> [TyConBinder] -> Kind -- ^ /result/ kind - -> [Role] -> Type -> Bool -> Bool -> Bool -> TyCon -mkSynonymTyCon name binders res_kind roles rhs is_tau is_fam_free is_forgetful + -> [Role] -> Type + -> Bool -> Bool -> Bool -> Bool + -> TyCon +mkSynonymTyCon name binders res_kind roles rhs is_tau + is_fam_free is_forgetful is_concrete = mkTyCon name binders res_kind roles $ SynonymTyCon { synTcRhs = rhs , synIsTau = is_tau , synIsFamFree = is_fam_free - , synIsForgetful = is_forgetful } + , synIsForgetful = is_forgetful + , synIsConcrete = is_concrete } -- | Create a type family 'TyCon' mkFamilyTyCon :: Name -> [TyConBinder] -> Kind -- ^ /result/ kind @@ -2353,29 +2361,23 @@ tcHasFixedRuntimeRep tc@(TyCon { tyConDetails = details }) | TcTyCon{} <- details = False | PromotedDataCon{} <- details = pprPanic "tcHasFixedRuntimeRep datacon" (ppr tc) --- | Is this 'TyCon' concrete (i.e. not a synonym/type family)? --- +-- | Is this 'TyCon' concrete? +-- More specifically, if 'tys' are all concrete, is (T tys) concrete? +-- (for synonyms this requires us to look at the RHS) -- Used for representation polymorphism checks. +-- See Note [Concrete types] in GHC.Tc.Utils.Concrete isConcreteTyCon :: TyCon -> Bool -isConcreteTyCon = isConcreteTyConFlavour . tyConFlavour +isConcreteTyCon tc@(TyCon { tyConDetails = details }) + = case details of + AlgTyCon {} -> True -- Includes AbstractTyCon + PrimTyCon {} -> True + PromotedDataCon {} -> True + FamilyTyCon {} -> False --- | Is this 'TyConFlavour' concrete (i.e. not a synonym/type family)? --- --- Used for representation polymorphism checks. -isConcreteTyConFlavour :: TyConFlavour -> Bool -isConcreteTyConFlavour = \case - ClassFlavour -> True - TupleFlavour {} -> True - SumFlavour -> True - DataTypeFlavour -> True - NewtypeFlavour -> True - AbstractTypeFlavour -> True -- See Note [Concrete types] in GHC.Tc.Utils.Concrete - DataFamilyFlavour {} -> False - OpenTypeFamilyFlavour {} -> False - ClosedTypeFamilyFlavour -> False - TypeSynonymFlavour -> False - BuiltInTypeFlavour -> True - PromotedDataConFlavour -> True + SynonymTyCon { synIsConcrete = is_conc } -> is_conc + + TcTyCon {} -> pprPanic "isConcreteTyCon" (ppr tc) + -- isConcreteTyCon is only used on "real" tycons {- ----------------------------------------------- ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -2204,15 +2204,20 @@ buildSynTyCon :: Name -> [KnotTied TyConBinder] -> Kind -- ^ /result/ kind -- This function is here because here is where we have -- isFamFree and isTauTy buildSynTyCon name binders res_kind roles rhs - = mkSynonymTyCon name binders res_kind roles rhs is_tau is_fam_free is_forgetful + = mkSynonymTyCon name binders res_kind roles rhs + is_tau is_fam_free is_forgetful is_concrete where is_tau = isTauTy rhs is_fam_free = isFamFreeTy rhs - is_forgetful = any (not . (`elemVarSet` tyCoVarsOfType rhs) . binderVar) binders || - uniqSetAny isForgetfulSynTyCon (tyConsOfType rhs) + is_concrete = uniqSetAll isConcreteTyCon rhs_tycons + is_forgetful = not (all ((`elemVarSet` rhs_tyvars) . binderVar) binders) || + uniqSetAny isForgetfulSynTyCon rhs_tycons -- NB: This is allowed to be conservative, returning True more often -- than it should. See comments on GHC.Core.TyCon.isForgetfulSynTyCon + rhs_tycons = tyConsOfType rhs + rhs_tyvars = tyCoVarsOfType rhs + {- ************************************************************************ * * @@ -2767,10 +2772,9 @@ isFixedRuntimeRepKind k isConcrete :: Type -> Bool isConcrete = go where - go ty | Just ty' <- coreView ty = go ty' go (TyVarTy tv) = isConcreteTyVar tv go (AppTy ty1 ty2) = go ty1 && go ty2 - go (TyConApp tc tys) + go (TyConApp tc tys) -- Works for synonyms too | isConcreteTyCon tc = all go tys | otherwise = False go ForAllTy{} = False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9ee8966e590a8d80d5d968558e4f11813d7f140 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9ee8966e590a8d80d5d968558e4f11813d7f140 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 12:09:36 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 15 Mar 2023 08:09:36 -0400 Subject: [Git][ghc/ghc][wip/interface-loading-errs] 2 commits: Convert interface file loading errors into proper diagnostics Message-ID: <6411b58082c40_37e76b1e3712fc2772e9@gitlab.mail> Matthew Pickering pushed to branch wip/interface-loading-errs at Glasgow Haskell Compiler / GHC Commits: 0798e5cb by Matthew Pickering at 2023-03-15T11:21:32+00:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the MissingInterfaceErrors into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the MissingInterfaceError This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the TcR - - - - - 4c2bf582 by Matthew Pickering at 2023-03-15T12:09:08+00:00 wip - - - - - 26 changed files: - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Tidy.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/Error.hs - ghc/GHCi/UI.hs - + ghc/GHCi/UI/Exception.hs - ghc/Main.hs - ghc/ghc-bin.cabal.in Changes: ===================================== compiler/GHC/Driver/Config/Diagnostic.hs ===================================== @@ -13,6 +13,7 @@ where import GHC.Driver.Flags import GHC.Driver.Session +import GHC.Prelude import GHC.Utils.Outputable import GHC.Utils.Error (DiagOpts (..)) @@ -48,7 +49,8 @@ initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage initPsMessageOpts _ = NoDiagnosticOpts initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage -initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags } +initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags + , tcOptsShowTriedFiles = verbosity dflags >= 3 } initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage initDsMessageOpts _ = NoDiagnosticOpts ===================================== compiler/GHC/Driver/Config/Tidy.hs ===================================== @@ -26,6 +26,10 @@ import GHC.Types.TyThing import GHC.Platform.Ways import qualified GHC.LanguageExtensions as LangExt +import GHC.Types.Error +import GHC.Utils.Error +import GHC.Tc.Errors.Types (TcRnMessage(..)) +import GHC.Driver.Config.Diagnostic (initTcMessageOpts) initTidyOpts :: HscEnv -> IO TidyOpts initTidyOpts hsc_env = do @@ -51,7 +55,11 @@ initStaticPtrOpts hsc_env = do let lookupM n = lookupGlobal_maybe hsc_env n >>= \case Succeeded r -> pure r - Failed err -> pprPanic "initStaticPtrOpts: couldn't find" (ppr (err,n)) + Failed err -> + let txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError err) + in pprPanic "initStaticPtrOpts: couldn't find" (ppr (txt, n)) + + mk_string <- getMkStringIds (fmap tyThingId . lookupM) static_ptr_info_datacon <- tyThingDataCon <$> lookupM staticPtrInfoDataConName ===================================== compiler/GHC/Driver/Errors.hs ===================================== @@ -13,7 +13,7 @@ import GHC.Types.SrcLoc import GHC.Types.SourceError import GHC.Types.Error import GHC.Utils.Error -import GHC.Utils.Outputable (hang, ppr, ($$), SDocContext, text, withPprStyle, mkErrStyle, sdocStyle ) +import GHC.Utils.Outputable (hang, ppr, ($$), text, mkErrStyle, sdocStyle, updSDocContext ) import GHC.Utils.Logger import qualified GHC.Driver.CmdLine as CmdLine @@ -22,21 +22,21 @@ printMessages logger msg_opts opts msgs = sequence_ [ let style = mkErrStyle name_ppr_ctx ctx = (diag_ppr_ctx opts) { sdocStyle = style } in logMsg logger (MCDiagnostic sev (diagnosticReason dia) (diagnosticCode dia)) s $ - withPprStyle style (messageWithHints ctx dia) + updSDocContext (\_ -> ctx) (messageWithHints dia) | MsgEnvelope { errMsgSpan = s, errMsgDiagnostic = dia, errMsgSeverity = sev, errMsgContext = name_ppr_ctx } <- sortMsgBag (Just opts) (getMessages msgs) ] where - messageWithHints :: Diagnostic a => SDocContext -> a -> SDoc - messageWithHints ctx e = - let main_msg = formatBulleted ctx $ diagnosticMessage msg_opts e + messageWithHints :: Diagnostic a => a -> SDoc + messageWithHints e = + let main_msg = formatBulleted $ diagnosticMessage msg_opts e in case diagnosticHints e of [] -> main_msg [h] -> main_msg $$ hang (text "Suggested fix:") 2 (ppr h) hs -> main_msg $$ hang (text "Suggested fixes:") 2 - (formatBulleted ctx . mkDecorated . map ppr $ hs) + (formatBulleted $ mkDecorated . map ppr $ hs) handleFlagWarnings :: Logger -> GhcMessageOpts -> DiagOpts -> [CmdLine.Warn] -> IO () handleFlagWarnings logger print_config opts warns = do ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -16,7 +16,7 @@ import GHC.Driver.Flags import GHC.Driver.Session import GHC.HsToCore.Errors.Ppr () import GHC.Parser.Errors.Ppr () -import GHC.Tc.Errors.Ppr () +import GHC.Tc.Errors.Ppr (missingInterfaceErrorHints, missingInterfaceErrorReason, missingInterfaceErrorDiagnostic) import GHC.Types.Error import GHC.Types.Error.Codes ( constructorCode ) import GHC.Unit.Types @@ -28,7 +28,7 @@ import GHC.Types.SrcLoc import Data.Version import Language.Haskell.Syntax.Decls (RuleDecl(..)) -import GHC.Tc.Errors.Types (TcRnMessage) +import GHC.Tc.Errors.Types (TcRnMessage, BuildingCabalPackage (..)) import GHC.HsToCore.Errors.Types (DsMessage) -- @@ -218,6 +218,7 @@ instance Diagnostic DriverMessage where -> mkSimpleDecorated $ vcat ([text "Home units are not closed." , text "It is necessary to also load the following units:" ] ++ map (\uid -> text "-" <+> ppr uid) needed_unit_ids) + DriverInterfaceError reason -> missingInterfaceErrorDiagnostic False reason diagnosticReason = \case DriverUnknownMessage m @@ -272,6 +273,7 @@ instance Diagnostic DriverMessage where -> ErrorWithoutFlag DriverHomePackagesNotClosed {} -> ErrorWithoutFlag + DriverInterfaceError reason -> missingInterfaceErrorReason reason diagnosticHints = \case DriverUnknownMessage m @@ -328,5 +330,6 @@ instance Diagnostic DriverMessage where -> noHints DriverHomePackagesNotClosed {} -> noHints + DriverInterfaceError reason -> missingInterfaceErrorHints reason diagnosticCode = constructorCode ===================================== compiler/GHC/Driver/Errors/Types.hs ===================================== @@ -8,7 +8,6 @@ module GHC.Driver.Errors.Types ( , DriverMessage(..) , DriverMessageOpts(..) , DriverMessages, PsMessage(PsHeaderMessage) - , BuildingCabalPackage(..) , WarningMessages , ErrorMessages , WarnMsg @@ -31,7 +30,6 @@ import GHC.Unit.Module import GHC.Unit.State import GHC.Parser.Errors.Types ( PsMessage(PsHeaderMessage) ) -import GHC.Tc.Errors.Types ( TcRnMessage ) import GHC.HsToCore.Errors.Types ( DsMessage ) import GHC.Hs.Extension (GhcTc) @@ -39,6 +37,8 @@ import Language.Haskell.Syntax.Decls (RuleDecl) import GHC.Generics ( Generic ) +import GHC.Tc.Errors.Types + -- | A collection of warning messages. -- /INVARIANT/: Each 'GhcMessage' in the collection should have 'SevWarning' severity. type WarningMessages = Messages GhcMessage @@ -368,21 +368,17 @@ data DriverMessage where DriverHomePackagesNotClosed :: ![UnitId] -> DriverMessage + DriverInterfaceError :: MissingInterfaceError -> DriverMessage + deriving instance Generic DriverMessage data DriverMessageOpts = DriverMessageOpts { psDiagnosticOpts :: DiagnosticOpts PsMessage } --- | Pass to a 'DriverMessage' the information whether or not the --- '-fbuilding-cabal-package' flag is set. -data BuildingCabalPackage - = YesBuildingCabalPackage - | NoBuildingCabalPackage - deriving Eq -- | Checks if we are building a cabal package by consulting the 'DynFlags'. checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage checkBuildingCabalPackage dflags = if gopt Opt_BuildingCabalPackage dflags then YesBuildingCabalPackage - else NoBuildingCabalPackage + else NoBuildingCabalPackage \ No newline at end of file ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -2330,7 +2330,7 @@ noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMe -- ToDo: we don't have a proper line number for this error noModError hsc_env loc wanted_mod err = mkPlainErrorMsgEnvelope loc $ GhcDriverMessage $ - DriverUnknownMessage $ UnknownDiagnostic $ mkPlainError noHints $ + DriverInterfaceError $ cannotFindModule hsc_env wanted_mod err {- ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Data.Graph.Directed ( SCC(..) ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain -import GHC.Types.Error (UnknownDiagnostic(..)) import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Types.PkgQual @@ -307,8 +306,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do fail -> throwOneError $ mkPlainErrorMsgEnvelope srcloc $ - GhcDriverMessage $ DriverUnknownMessage $ - UnknownDiagnostic $ mkPlainError noHints $ + GhcDriverMessage $ DriverInterfaceError $ cannotFindModule hsc_env imp fail ----------------------------- ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -3,14 +3,9 @@ module GHC.Iface.Errors ( badIfaceFile - , hiModuleNameMismatchWarn - , homeModError , cannotFindInterface , cantFindInstalledErr , cannotFindModule - , cantFindErr - -- * Utility functions - , mayShowLocations ) where import GHC.Platform.Profile @@ -25,6 +20,7 @@ import GHC.Unit import GHC.Unit.Env import GHC.Unit.Finder.Types import GHC.Utils.Outputable as Outputable +import GHC.Tc.Errors.Types (MissingInterfaceError (..), CantFindInstalled(..), CantFindInstalledReason(..), CantFindWhat(..), BuildingCabalPackage) badIfaceFile :: String -> SDoc -> SDoc @@ -32,66 +28,35 @@ badIfaceFile file err = vcat [text "Bad interface file:" <+> text file, nest 4 err] -hiModuleNameMismatchWarn :: Module -> Module -> SDoc -hiModuleNameMismatchWarn requested_mod read_mod - | moduleUnit requested_mod == moduleUnit read_mod = - sep [text "Interface file contains module" <+> quotes (ppr read_mod) <> comma, - text "but we were expecting module" <+> quotes (ppr requested_mod), - sep [text "Probable cause: the source code which generated interface file", - text "has an incompatible module name" - ] - ] - | otherwise = - -- ToDo: This will fail to have enough qualification when the package IDs - -- are the same - withPprStyle (mkUserStyle alwaysQualify AllTheWay) $ - -- we want the Modules below to be qualified with package names, - -- so reset the NamePprCtx setting. - hsep [ text "Something is amiss; requested module " - , ppr requested_mod - , text "differs from name found in the interface file" - , ppr read_mod - , parens (text "if these names look the same, try again with -dppr-debug") - ] - -homeModError :: InstalledModule -> ModLocation -> SDoc --- See Note [Home module load error] -homeModError mod location - = text "attempting to use module " <> quotes (ppr mod) - <> (case ml_hs_file location of - Just file -> space <> parens (text file) - Nothing -> Outputable.empty) - <+> text "which is not loaded" + -- ----------------------------------------------------------------------------- -- Error messages -cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc -cannotFindInterface = cantFindInstalledErr (text "Failed to load interface for") - (text "Ambiguous interface for") +cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile -> ModuleName -> InstalledFindResult -> MissingInterfaceError +cannotFindInterface us mhu p mn ifr = CantFindInstalledErr (cantFindInstalledErr CantLoadInterface + AmbiguousInterface us mhu p mn ifr) + cantFindInstalledErr - :: SDoc - -> SDoc + :: CantFindWhat + -> CantFindWhat -> UnitState -> Maybe HomeUnit -> Profile - -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult - -> SDoc -cantFindInstalledErr cannot_find _ unit_state mhome_unit profile tried_these mod_name find_result - = cannot_find <+> quotes (ppr mod_name) - $$ more_info + -> CantFindInstalled +cantFindInstalledErr cannot_find _ unit_state mhome_unit profile mod_name find_result + = CantFindInstalled mod_name cannot_find more_info where build_tag = waysBuildTag (profileWays profile) more_info = case find_result of InstalledNoPackage pkg - -> text "no unit id matching" <+> quotes (ppr pkg) <+> - text "was found" $$ looks_like_srcpkgid pkg + -> NoUnitIdMatching pkg (searchPackageId unit_state (PackageId (unitIdFS pkg))) InstalledNotFound files mb_pkg | Just pkg <- mb_pkg @@ -99,65 +64,45 @@ cantFindInstalledErr cannot_find _ unit_state mhome_unit profile tried_these mod -> not_found_in_package pkg files | null files - -> text "It is not a module in the current program, or in any known package." + -> NotAModule | otherwise - -> tried_these files + -> CouldntFindInFiles files _ -> panic "cantFindInstalledErr" - looks_like_srcpkgid :: UnitId -> SDoc - looks_like_srcpkgid pk - -- Unsafely coerce a unit id (i.e. an installed package component - -- identifier) into a PackageId and see if it means anything. - | (pkg:pkgs) <- searchPackageId unit_state (PackageId (unitIdFS pk)) - = parens (text "This unit ID looks like the source package ID;" $$ - text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$ - (if null pkgs then Outputable.empty - else text "and" <+> int (length pkgs) <+> text "other candidates")) - -- Todo: also check if it looks like a package name! - | otherwise = Outputable.empty - not_found_in_package pkg files | build_tag /= "" = let build = if build_tag == "p" then "profiling" else "\"" ++ build_tag ++ "\"" in + MissingPackageWayFiles build pkg files + {- text "Perhaps you haven't installed the " <> text build <> text " libraries for package " <> quotes (ppr pkg) <> char '?' $$ tried_these files + -} | otherwise - = text "There are files missing in the " <> quotes (ppr pkg) <> - text " package," $$ - text "try running 'ghc-pkg check'." $$ - tried_these files + = MissingPackageFiles pkg files -mayShowLocations :: DynFlags -> [FilePath] -> SDoc -mayShowLocations dflags files - | null files = Outputable.empty - | verbosity dflags < 3 = - text "Use -v (or `:set -v` in ghci) " <> - text "to see a list of the files searched for." - | otherwise = - hang (text "Locations searched:") 2 $ vcat (map text files) -cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc + +cannotFindModule :: HscEnv -> ModuleName -> FindResult -> MissingInterfaceError cannotFindModule hsc_env = cannotFindModule' (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (targetProfile (hsc_dflags hsc_env)) -cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc -cannotFindModule' dflags unit_env profile mod res = pprWithUnitState (ue_units unit_env) $ +cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> MissingInterfaceError +cannotFindModule' dflags unit_env profile mod res = CantFindErr (ue_units unit_env) $ cantFindErr (checkBuildingCabalPackage dflags) cannotFindMsg - (text "Ambiguous module name") + AmbigiousModule unit_env profile - (mayShowLocations dflags) mod res where @@ -167,84 +112,58 @@ cannotFindModule' dflags unit_env profile mod res = pprWithUnitState (ue_units u , fr_pkgs_hidden = hidden_pkgs , fr_unusables = unusables } | not (null hidden_mods && null hidden_pkgs && null unusables) - -> text "Could not load module" - _ -> text "Could not find module" + -> CantLoadModule + _ -> CantFindModule cantFindErr :: BuildingCabalPackage -- ^ Using Cabal? - -> SDoc - -> SDoc + -> CantFindWhat + -> CantFindWhat -> UnitEnv -> Profile - -> ([FilePath] -> SDoc) -> ModuleName -> FindResult - -> SDoc -cantFindErr _ _ multiple_found _ _ _ mod_name (FoundMultiple mods) + -> CantFindInstalled +cantFindErr _ _ multiple_found _ _ mod_name (FoundMultiple mods) | Just pkgs <- unambiguousPackages - = hang (multiple_found <+> quotes (ppr mod_name) <> colon) 2 ( - sep [text "it was found in multiple packages:", - hsep (map ppr pkgs) ] - ) + = CantFindInstalled mod_name multiple_found (MultiplePackages pkgs) | otherwise - = hang (multiple_found <+> quotes (ppr mod_name) <> colon) 2 ( - vcat (map pprMod mods) - ) + = CantFindInstalled mod_name multiple_found (MultiplePackages2 mods) where unambiguousPackages = foldl' unambiguousPackage (Just []) mods unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) = Just (moduleUnit m : xs) unambiguousPackage _ _ = Nothing - pprMod (m, o) = text "it is bound as" <+> ppr m <+> - text "by" <+> pprOrigin m o - pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden" - pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable" - pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma ( - if e == Just True - then [text "package" <+> ppr (moduleUnit m)] - else [] ++ - map ((text "a reexport in package" <+>) - .ppr.mkUnit) res ++ - if f then [text "a package flag"] else [] - ) - -cantFindErr using_cabal cannot_find _ unit_env profile tried_these mod_name find_result - = cannot_find <+> quotes (ppr mod_name) - $$ more_info +cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result + = CantFindInstalled mod_name cannot_find more_info where mhome_unit = ue_homeUnit unit_env more_info = case find_result of NoPackage pkg - -> text "no unit id matching" <+> quotes (ppr pkg) <+> - text "was found" - + -> NoUnitIdMatching (toUnitId pkg) [] NotFound { fr_paths = files, fr_pkg = mb_pkg , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens , fr_unusables = unusables, fr_suggestions = suggest } | Just pkg <- mb_pkg , Nothing <- mhome_unit -- no home-unit - -> not_found_in_package pkg files + -> not_found_in_package (toUnitId pkg) files | Just pkg <- mb_pkg , Just home_unit <- mhome_unit -- there is a home-unit but the , not (isHomeUnit home_unit pkg) -- module isn't from it - -> not_found_in_package pkg files + -> not_found_in_package (toUnitId pkg) files | not (null suggest) - -> pp_suggestions suggest $$ tried_these files + -> ModuleSuggestion suggest files | null files && null mod_hiddens && null pkg_hiddens && null unusables - -> text "It is not a module in the current program, or in any known package." + -> NotAModule | otherwise - -> vcat (map pkg_hidden pkg_hiddens) $$ - vcat (map mod_hidden mod_hiddens) $$ - vcat (map unusable unusables) $$ - tried_these files - + -> GenericMissing using_cabal (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) mod_hiddens unusables files _ -> panic "cantFindErr" build_tag = waysBuildTag (profileWays profile) @@ -255,81 +174,7 @@ cantFindErr using_cabal cannot_find _ unit_env profile tried_these mod_name find build = if build_tag == "p" then "profiling" else "\"" ++ build_tag ++ "\"" in - text "Perhaps you haven't installed the " <> text build <> - text " libraries for package " <> quotes (ppr pkg) <> char '?' $$ - tried_these files + MissingPackageWayFiles build pkg files | otherwise - = text "There are files missing in the " <> quotes (ppr pkg) <> - text " package," $$ - text "try running 'ghc-pkg check'." $$ - tried_these files - - pkg_hidden :: Unit -> SDoc - pkg_hidden uid = - text "It is a member of the hidden package" - <+> quotes (ppr uid) - --FIXME: we don't really want to show the unit id here we should - -- show the source package id or installed package id if it's ambiguous - <> dot $$ pkg_hidden_hint uid - - pkg_hidden_hint uid - | using_cabal == YesBuildingCabalPackage - = let pkg = expectJust "pkg_hidden" (lookupUnit (ue_units unit_env) uid) - in text "Perhaps you need to add" <+> - quotes (ppr (unitPackageName pkg)) <+> - text "to the build-depends in your .cabal file." - | Just pkg <- lookupUnit (ue_units unit_env) uid - = text "You can run" <+> - quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> - text "to expose it." $$ - text "(Note: this unloads all the modules in the current scope.)" - | otherwise = Outputable.empty - - mod_hidden pkg = - text "it is a hidden module in the package" <+> quotes (ppr pkg) - - unusable (pkg, reason) - = text "It is a member of the package" - <+> quotes (ppr pkg) - $$ pprReason (text "which is") reason - - pp_suggestions :: [ModuleSuggestion] -> SDoc - pp_suggestions sugs - | null sugs = Outputable.empty - | otherwise = hang (text "Perhaps you meant") - 2 (vcat (map pp_sugg sugs)) - - -- NB: Prefer the *original* location, and then reexports, and then - -- package flags when making suggestions. ToDo: if the original package - -- also has a reexport, prefer that one - pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o - where provenance ModHidden = Outputable.empty - provenance (ModUnusable _) = Outputable.empty - provenance (ModOrigin{ fromOrigUnit = e, - fromExposedReexport = res, - fromPackageFlag = f }) - | Just True <- e - = parens (text "from" <+> ppr (moduleUnit mod)) - | f && moduleName mod == m - = parens (text "from" <+> ppr (moduleUnit mod)) - | (pkg:_) <- res - = parens (text "from" <+> ppr (mkUnit pkg) - <> comma <+> text "reexporting" <+> ppr mod) - | f - = parens (text "defined via package flags to be" - <+> ppr mod) - | otherwise = Outputable.empty - pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o - where provenance ModHidden = Outputable.empty - provenance (ModUnusable _) = Outputable.empty - provenance (ModOrigin{ fromOrigUnit = e, - fromHiddenReexport = rhs }) - | Just False <- e - = parens (text "needs flag -package-id" - <+> ppr (moduleUnit mod)) - | (pkg:_) <- rhs - = parens (text "needs flag -package-id" - <+> ppr (mkUnit pkg)) - | otherwise = Outputable.empty - + = MissingPackageFiles pkg files \ No newline at end of file ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -143,7 +143,7 @@ where the code that e1 expands to might import some defns that also turn out to be needed by the code that e2 expands to. -} -tcLookupImported_maybe :: Name -> TcM (MaybeErr SDoc TyThing) +tcLookupImported_maybe :: Name -> TcM (MaybeErr MissingInterfaceError TyThing) -- Returns (Failed err) if we can't find the interface file for the thing tcLookupImported_maybe name = do { hsc_env <- getTopEnv @@ -152,7 +152,7 @@ tcLookupImported_maybe name Just thing -> return (Succeeded thing) Nothing -> tcImportDecl_maybe name } -tcImportDecl_maybe :: Name -> TcM (MaybeErr SDoc TyThing) +tcImportDecl_maybe :: Name -> TcM (MaybeErr MissingInterfaceError TyThing) -- Entry point for *source-code* uses of importDecl tcImportDecl_maybe name | Just thing <- wiredInNameTyThing_maybe name @@ -163,7 +163,7 @@ tcImportDecl_maybe name | otherwise = initIfaceTcRn (importDecl name) -importDecl :: Name -> IfM lcl (MaybeErr SDoc TyThing) +importDecl :: Name -> IfM lcl (MaybeErr MissingInterfaceError TyThing) -- Get the TyThing for this Name from an interface file -- It's not a wired-in thing -- the caller caught that importDecl name @@ -182,21 +182,11 @@ importDecl name { eps <- getEps ; case lookupTypeEnv (eps_PTE eps) name of Just thing -> return $ Succeeded thing - Nothing -> let doc = whenPprDebug (found_things_msg eps $$ empty) - $$ not_found_msg - in return $ Failed doc + Nothing -> return $ Failed (MissingDeclInInterface name (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps)) }}} where nd_doc = text "Need decl for" <+> ppr name - not_found_msg = hang (text "Can't find interface-file declaration for" <+> - pprNameSpace (nameNameSpace name) <+> ppr name) - 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", - text "Use -ddump-if-trace to get an idea of which file caused the error"]) - found_things_msg eps = - hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon) - 2 (vcat (map ppr $ filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps)) - where - is_interesting thing = nameModule name == nameModule (getName thing) + is_interesting thing = nameModule name == nameModule (getName thing) {- @@ -299,7 +289,7 @@ loadSrcInterface :: SDoc loadSrcInterface doc mod want_boot maybe_pkg = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg ; case res of - Failed err -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints err) + Failed err -> failWithTc (TcRnMissingInterfaceError err) Succeeded iface -> return iface } -- | Like 'loadSrcInterface', but returns a 'MaybeErr'. @@ -307,7 +297,7 @@ loadSrcInterface_maybe :: SDoc -> ModuleName -> IsBootInterface -- {-# SOURCE #-} ? -> PkgQual -- "package", if any - -> RnM (MaybeErr SDoc ModIface) + -> RnM (MaybeErr MissingInterfaceError ModIface) loadSrcInterface_maybe doc mod want_boot maybe_pkg -- We must first find which Module this import refers to. This involves @@ -403,11 +393,11 @@ loadInterfaceWithException doc mod_name where_from = do dflags <- getDynFlags let ctx = initSDocContext dflags defaultUserStyle - withException ctx (loadInterface doc mod_name where_from) + withIfaceErr ctx (loadInterface doc mod_name where_from) ------------------ loadInterface :: SDoc -> Module -> WhereFrom - -> IfM lcl (MaybeErr SDoc ModIface) + -> IfM lcl (MaybeErr MissingInterfaceError ModIface) -- loadInterface looks in both the HPT and PIT for the required interface -- If not found, it loads it, and puts it in the PIT (always). @@ -703,7 +693,7 @@ computeInterface -> SDoc -> IsBootInterface -> Module - -> IO (MaybeErr SDoc (ModIface, FilePath)) + -> IO (MaybeErr MissingInterfaceError (ModIface, FilePath)) computeInterface hsc_env doc_str hi_boot_file mod0 = do massert (not (isHoleModule mod0)) let mhome_unit = hsc_home_unit_maybe hsc_env @@ -732,7 +722,7 @@ computeInterface hsc_env doc_str hi_boot_file mod0 = do -- @p[A=\,B=\]:B@ never includes B. moduleFreeHolesPrecise :: SDoc -> Module - -> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName)) + -> TcRnIf gbl lcl (MaybeErr MissingInterfaceError (UniqDSet ModuleName)) moduleFreeHolesPrecise doc_str mod | moduleIsDefinite mod = return (Succeeded emptyUniqDSet) | otherwise = @@ -769,13 +759,13 @@ moduleFreeHolesPrecise doc_str mod Failed err -> return (Failed err) wantHiBootFile :: Maybe HomeUnit -> ExternalPackageState -> Module -> WhereFrom - -> MaybeErr SDoc IsBootInterface + -> MaybeErr MissingInterfaceError IsBootInterface -- Figure out whether we want Foo.hi or Foo.hi-boot wantHiBootFile mhome_unit eps mod from = case from of ImportByUser usr_boot | usr_boot == IsBoot && notHomeModuleMaybe mhome_unit mod - -> Failed (badSourceImport mod) + -> Failed (BadSourceImport mod) | otherwise -> Succeeded usr_boot ImportByPlugin @@ -798,11 +788,6 @@ wantHiBootFile mhome_unit eps mod from -- The boot-ness of the requested interface, -- based on the dependencies in directly-imported modules -badSourceImport :: Module -> SDoc -badSourceImport mod - = hang (text "You cannot {-# SOURCE #-} import a module from another package") - 2 (text "but" <+> quotes (ppr mod) <+> text "is from package" - <+> quotes (ppr (moduleUnit mod))) ----------------------------------------------------- -- Loading type/class/value decls @@ -855,7 +840,7 @@ findAndReadIface -- this to check the consistency of the requirements of the -- module we read out. -> IsBootInterface -- ^ Looking for .hi-boot or .hi file - -> IO (MaybeErr SDoc (ModIface, FilePath)) + -> IO (MaybeErr MissingInterfaceError (ModIface, FilePath)) findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do let profile = targetProfile dflags @@ -897,7 +882,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do Just home_unit | isHomeInstalledModule home_unit mod , not (isOneShot (ghcMode dflags)) - -> return (Failed (homeModError mod loc)) + -> return (Failed (HomeModError mod loc)) _ -> do r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc) case r of @@ -917,39 +902,34 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do unit_state mhome_unit profile - (Iface_Errors.mayShowLocations dflags) (moduleName mod) err -- | Check if we need to try the dynamic interface for -dynamic-too -load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr SDoc ()) +load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc -- Indefinite interfaces are ALWAYS non-dynamic. | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ()) | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc | otherwise = return (Succeeded ()) -load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr SDoc ()) +load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case Succeeded (dynIface, _) | mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface) -> return (Succeeded ()) | otherwise -> - do return $ (Failed $ dynamicHashMismatchError wanted_mod loc) + do return $ (Failed $ DynamicHashMismatchError wanted_mod loc) Failed err -> - do return $ (Failed $ ((text "Failed to load dynamic interface file for" <+> ppr wanted_mod <> colon) $$ err)) + do return $ (Failed $ FailedToLoadDynamicInterface wanted_mod err) + --((text "Failed to load dynamic interface file for" <+> ppr wanted_mod <> colon) $$ err)) -dynamicHashMismatchError :: Module -> ModLocation -> SDoc -dynamicHashMismatchError wanted_mod loc = - vcat [ text "Dynamic hash doesn't match for" <+> quotes (ppr wanted_mod) - , text "Normal interface file from" <+> text (ml_hi_file loc) - , text "Dynamic interface file from" <+> text (ml_dyn_hi_file loc) - , text "You probably need to recompile" <+> quotes (ppr wanted_mod) ] -read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr SDoc (ModIface, FilePath)) + +read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr MissingInterfaceError (ModIface, FilePath)) read_file logger name_cache unit_state dflags wanted_mod file_path = do trace_if logger (text "readIFace" <+> text file_path) @@ -964,7 +944,7 @@ read_file logger name_cache unit_state dflags wanted_mod file_path = do (uninstantiateInstantiatedModule indef_mod) read_result <- readIface dflags name_cache wanted_mod' file_path case read_result of - Failed err -> return (Failed (badIfaceFile file_path err)) + Failed err -> return (Failed (BadIfaceFile file_path err)) Succeeded iface -> return (Succeeded (iface, file_path)) -- Don't forget to fill in the package name... @@ -985,7 +965,7 @@ readIface -> NameCache -> Module -> FilePath - -> IO (MaybeErr SDoc ModIface) + -> IO (MaybeErr MissingInterfaceError ModIface) readIface dflags name_cache wanted_mod file_path = do let profile = targetProfile dflags res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path @@ -999,9 +979,9 @@ readIface dflags name_cache wanted_mod file_path = do | otherwise -> return (Failed err) where actual_mod = mi_module iface - err = hiModuleNameMismatchWarn wanted_mod actual_mod + err = HiModuleNameMismatchWarn wanted_mod actual_mod - Left exn -> return (Failed (text (showException exn))) + Left exn -> return (Failed (GenericException exn)) {- ********************************************************* ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -83,6 +83,7 @@ import GHC.List (uncons) import Data.Ord import Data.Containers.ListUtils import Data.Bifunctor +import GHC.Tc.Errors.Ppr (missingInterfaceErrorDiagnostic) {- ----------------------------------------------- @@ -292,8 +293,8 @@ check_old_iface hsc_env mod_summary maybe_iface read_result <- readIface read_dflags ncu (ms_mod mod_summary) iface_path case read_result of Failed err -> do - trace_if logger (text "FYI: cannot read old interface file:" $$ nest 4 err) - trace_hi_diffs logger (text "Old interface file was invalid:" $$ nest 4 err) + trace_if logger (text "FYI: cannot read old interface file:" $$ nest 4 (formatBulleted $ missingInterfaceErrorDiagnostic False err)) + trace_hi_diffs logger (text "Old interface file was invalid:" $$ nest 4 (formatBulleted $ missingInterfaceErrorDiagnostic False err)) return Nothing Succeeded iface -> do trace_if logger (text "Read the interface file" <+> text iface_path) @@ -1319,7 +1320,7 @@ getOrphanHashes hsc_env mods = do dflags = hsc_dflags hsc_env ctx = initSDocContext dflags defaultUserStyle get_orph_hash mod = do - iface <- initIfaceLoad hsc_env . withException ctx + iface <- initIfaceLoad hsc_env . withIfaceErr ctx $ loadInterface (text "getOrphanHashes") mod ImportBySystem return (mi_orphan_hash (mi_final_exts iface)) @@ -1614,7 +1615,7 @@ mkHashFun hsc_env eps name -- requirements; we didn't do any /real/ typechecking -- so there's no guarantee everything is loaded. -- Kind of a heinous hack. - initIfaceLoad hsc_env . withException ctx + initIfaceLoad hsc_env . withIfaceErr ctx $ withoutDynamicNow -- If you try and load interfaces when dynamic-too -- enabled then it attempts to load the dyn_hi and hi ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -130,6 +130,8 @@ import GHC.Unit.Module.WholeCoreBindings import Data.IORef import Data.Foldable import GHC.Builtin.Names (ioTyConName, rOOT_MAIN) +import GHC.Tc.Errors.Ppr (missingInterfaceErrorDiagnostic) +import GHC.Utils.Error {- This module takes @@ -596,7 +598,7 @@ tcHiBootIface hsc_src mod Nothing -> return NoSelfBoot -- error cases Just (GWIB { gwib_isBoot = is_boot }) -> case is_boot of - IsBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints (elaborate err)) + IsBoot -> failWithTc (TcRnMissingInterfaceError (CantFindHiBoot mod err)) -- The hi-boot file has mysteriously disappeared. NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop) -- Someone below us imported us! @@ -609,8 +611,6 @@ tcHiBootIface hsc_src mod moduleLoop = text "Circular imports: module" <+> quotes (ppr mod) <+> text "depends on itself" - elaborate err = hang (text "Could not find hi-boot interface for" <+> - quotes (ppr mod) <> colon) 4 err mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo @@ -1961,7 +1961,7 @@ tcIfaceGlobal name { mb_thing <- importDecl name -- It's imported; go get it ; case mb_thing of - Failed err -> failIfM (ppr name <+> err) + Failed err -> failIfM (ppr name <+> (formatBulleted $ missingInterfaceErrorDiagnostic False err)) Succeeded thing -> return thing }}} ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -120,6 +120,7 @@ import GHC.Iface.Load import GHC.Unit.Home import Data.Either import Control.Applicative +import GHC.Tc.Errors.Types (TcRnMessage(..)) uninitialised :: a uninitialised = panic "Loader not initialised" @@ -791,7 +792,9 @@ getLinkDeps hsc_env pls replace_osuf span mods mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $ loadInterface msg mod (ImportByUser NotBoot) iface <- case mb_iface of - Maybes.Failed err -> throwGhcExceptionIO (ProgramError (showSDoc dflags err)) + Maybes.Failed err -> + let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError err) + in throwGhcExceptionIO (ProgramError (showSDoc dflags err_txt)) Maybes.Succeeded iface -> return iface when (mi_boot iface == IsBoot) $ link_boot_mod_error mod ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -71,6 +71,8 @@ import Unsafe.Coerce ( unsafeCoerce ) import GHC.Linker.Types import GHC.Types.Unique.DFM import Data.List (unzip4) +import GHC.Tc.Errors.Types (TcRnMessage(..)) +import GHC.Driver.Config.Diagnostic (initTcMessageOpts) -- | Loads the plugins specified in the pluginModNames field of the dynamic -- flags. Should be called after command line arguments are parsed, but before @@ -328,7 +330,9 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do _ -> panic "lookupRdrNameInModule" Nothing -> throwCmdLineErrorS dflags $ hsep [text "Could not determine the exports of the module", ppr mod_name] - err -> throwCmdLineErrorS dflags $ cannotFindModule hsc_env mod_name err + err -> + let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError (cannotFindModule hsc_env mod_name err)) + in throwCmdLineErrorS dflags err_txt where doc = text "contains a name used in an invocation of lookupRdrNameInModule" ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -20,6 +20,10 @@ module GHC.Tc.Errors.Ppr , pprHsDocContext , inHsDocContext , TcRnMessageOpts(..) + + , missingInterfaceErrorHints + , missingInterfaceErrorReason + , missingInterfaceErrorDiagnostic ) where @@ -74,7 +78,7 @@ import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env -import GHC.Unit.State (pprWithUnitState, UnitState) +import GHC.Unit.State import GHC.Unit.Module import GHC.Unit.Module.Warnings ( pprWarningTxtForMsg ) @@ -101,10 +105,12 @@ import GHC.Types.Name.Env import qualified Language.Haskell.TH as TH data TcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext :: !Bool -- ^ Whether we show the error context or not + , tcOptsShowTriedFiles :: !Bool -- ^ Whether to show files we tried to look for or not when printing loader errors } defaultTcRnMessageOpts :: TcRnMessageOpts -defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext = True } +defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext = True + , tcOptsShowTriedFiles = False } instance Diagnostic TcRnMessage where @@ -1162,7 +1168,6 @@ instance Diagnostic TcRnMessage where True -> text (show item) False -> text (TH.pprint item)) TcRnReportCustomQuasiError _ msg -> mkSimpleDecorated $ text msg - TcRnInterfaceLookupError _ sdoc -> mkSimpleDecorated sdoc TcRnUnsatisfiedMinimalDef mindef -> mkSimpleDecorated $ vcat [text "No explicit implementation for" @@ -1407,6 +1412,10 @@ instance Diagnostic TcRnMessage where , text "on the RHS of injectivity condition:" , interpp'SP errorVars ] + TcRnMissingInterfaceError reason + -> missingInterfaceErrorDiagnostic (tcOptsShowTriedFiles opts) reason + + diagnosticReason = \case TcRnUnknownMessage m -> diagnosticReason m @@ -1772,8 +1781,6 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnReportCustomQuasiError isError _ -> if isError then ErrorWithoutFlag else WarningWithoutFlag - TcRnInterfaceLookupError{} - -> ErrorWithoutFlag TcRnUnsatisfiedMinimalDef{} -> WarningWithFlag (Opt_WarnMissingMethods) TcRnMisplacedInstSig{} @@ -1870,6 +1877,23 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnUnknownTyVarsOnRhsOfInjCond{} -> ErrorWithoutFlag + TcRnMissingInterfaceError reason + -> case reason of + BadSourceImport {} -> ErrorWithoutFlag + MissingDeclInInterface {} -> ErrorWithoutFlag + HomeModError {} -> ErrorWithoutFlag + DynamicHashMismatchError {} -> ErrorWithoutFlag + CantFindErr {} -> ErrorWithoutFlag + CantFindInstalledErr {} -> ErrorWithoutFlag + HiModuleNameMismatchWarn {} -> ErrorWithoutFlag + BadIfaceFile {} -> ErrorWithoutFlag + FailedToLoadDynamicInterface {} -> ErrorWithoutFlag + GenericException {} -> ErrorWithoutFlag + CantFindLocalName {} -> ErrorWithoutFlag + CantFindHiInterfaceForSig {} -> ErrorWithoutFlag + CantFindHiBoot {} -> ErrorWithoutFlag + InterfaceLookupError {} -> ErrorWithoutFlag + diagnosticHints = \case TcRnUnknownMessage m @@ -2242,8 +2266,6 @@ instance Diagnostic TcRnMessage where -> noHints TcRnReportCustomQuasiError{} -> noHints - TcRnInterfaceLookupError{} - -> noHints TcRnUnsatisfiedMinimalDef{} -> noHints TcRnMisplacedInstSig{} @@ -2352,6 +2374,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnUnknownTyVarsOnRhsOfInjCond{} -> noHints + TcRnMissingInterfaceError reason + -> missingInterfaceErrorHints reason diagnosticCode = constructorCode @@ -2366,6 +2390,256 @@ commafyWith conjunction xs = addConjunction $ punctuate comma xs addConjunction (x : xs) = x : addConjunction xs addConjunction _ = panic "commafyWith expected 2 or more elements" +missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint] +missingInterfaceErrorHints reason = + case reason of + BadSourceImport {} -> noHints + MissingDeclInInterface {} -> noHints + HomeModError {} -> noHints + DynamicHashMismatchError {} -> noHints + CantFindErr {} -> noHints + CantFindInstalledErr {} -> noHints + HiModuleNameMismatchWarn {} -> noHints + BadIfaceFile {} -> noHints + FailedToLoadDynamicInterface {} -> noHints + GenericException {} -> noHints + CantFindLocalName {} -> noHints + CantFindHiInterfaceForSig {} -> noHints + CantFindHiBoot {} -> noHints + InterfaceLookupError {} -> noHints + +missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason +missingInterfaceErrorReason _reason = ErrorWithoutFlag + +prettyCantFindWhat :: CantFindWhat -> SDoc +prettyCantFindWhat CantFindModule = text "Could not find module" +prettyCantFindWhat CantLoadModule = text "Could not load module" +prettyCantFindWhat CantLoadInterface = text "Failed to load interface for" +prettyCantFindWhat AmbigiousModule = text "Ambiguous module name" +prettyCantFindWhat AmbiguousInterface = text "Ambigious interface for" + +cantFindError :: Bool -> CantFindInstalled -> DecoratedSDoc +cantFindError verbose (CantFindInstalled mod_name what cfir) = + mkSimpleDecorated (prettyCantFindWhat what <+> quotes (ppr mod_name)) `unionDecoratedSDoc` + case cfir of + NoUnitIdMatching pkg cands -> + + let looks_like_srcpkgid :: SDoc + looks_like_srcpkgid = + -- Unsafely coerce a unit id (i.e. an installed package component + -- identifier) into a PackageId and see if it means anything. + case cands of + (pkg:pkgs) -> parens (text "This unit ID looks like the source package ID;" $$ + text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$ + (if null pkgs then empty + else text "and" <+> int (length pkgs) <+> text "other candidates")) + -- Todo: also check if it looks like a package name! + [] -> empty + + in mkSimpleDecorated (text "no unit id matching" <+> quotes (ppr pkg) <+> + text "was found" $$ looks_like_srcpkgid) + MissingPackageFiles pkg files -> + mkSimpleDecorated $ + text "There are files missing in the " <> quotes (ppr pkg) <> + text " package," $$ + text "try running 'ghc-pkg check'." $$ + mayShowLocations verbose files + MissingPackageWayFiles build pkg files -> + mkSimpleDecorated $ + text "Perhaps you haven't installed the " <> text build <> + text " libraries for package " <> quotes (ppr pkg) <> char '?' $$ + mayShowLocations verbose files + ModuleSuggestion ms fps -> + + let pp_suggestions :: [ModuleSuggestion] -> SDoc + pp_suggestions sugs + | null sugs = empty + | otherwise = hang (text "Perhaps you meant") + 2 (vcat (map pp_sugg sugs)) + + -- NB: Prefer the *original* location, and then reexports, and then + -- package flags when making suggestions. ToDo: if the original package + -- also has a reexport, prefer that one + pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o + where provenance ModHidden = empty + provenance (ModUnusable _) = empty + provenance (ModOrigin{ fromOrigUnit = e, + fromExposedReexport = res, + fromPackageFlag = f }) + | Just True <- e + = parens (text "from" <+> ppr (moduleUnit mod)) + | f && moduleName mod == m + = parens (text "from" <+> ppr (moduleUnit mod)) + | (pkg:_) <- res + = parens (text "from" <+> ppr (mkUnit pkg) + <> comma <+> text "reexporting" <+> ppr mod) + | f + = parens (text "defined via package flags to be" + <+> ppr mod) + | otherwise = empty + pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o + where provenance ModHidden = empty + provenance (ModUnusable _) = empty + provenance (ModOrigin{ fromOrigUnit = e, + fromHiddenReexport = rhs }) + | Just False <- e + = parens (text "needs flag -package-id" + <+> ppr (moduleUnit mod)) + | (pkg:_) <- rhs + = parens (text "needs flag -package-id" + <+> ppr (mkUnit pkg)) + | otherwise = empty + + in mkSimpleDecorated $ pp_suggestions ms $$ mayShowLocations verbose fps + NotAModule -> mkSimpleDecorated $ text "It is not a module in the current program, or in any known package." + CouldntFindInFiles fps -> mkSimpleDecorated (vcat (map text fps)) + MultiplePackages pkgs -> mkSimpleDecorated $ + sep [text "it was found in multiple packages:", + hsep (map ppr pkgs)] + MultiplePackages2 mods -> mkSimpleDecorated $ + vcat (map pprMod mods) + GenericMissing using_cabal pkg_hiddens mod_hiddens unusables files -> mkSimpleDecorated $ + vcat (map (pkg_hidden using_cabal) pkg_hiddens) $$ + vcat (map mod_hidden mod_hiddens) $$ + vcat (map unusable unusables) $$ + mayShowLocations verbose files + where + pprMod (m, o) = text "it is bound as" <+> ppr m <+> + text "by" <+> pprOrigin m o + pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden" + pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable" + pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma ( + if e == Just True + then [text "package" <+> ppr (moduleUnit m)] + else [] ++ + map ((text "a reexport in package" <+>) + .ppr.mkUnit) res ++ + if f then [text "a package flag"] else [] + ) + pkg_hidden :: BuildingCabalPackage -> (Unit, Maybe UnitInfo) -> SDoc + pkg_hidden using_cabal (uid, uif) = + text "It is a member of the hidden package" + <+> quotes (ppr uid) + --FIXME: we don't really want to show the unit id here we should + -- show the source package id or installed package id if it's ambiguous + <> dot $$ pkg_hidden_hint using_cabal uif + + pkg_hidden_hint using_cabal (Just pkg) + | using_cabal == YesBuildingCabalPackage + = text "Perhaps you need to add" <+> + quotes (ppr (unitPackageName pkg)) <+> + text "to the build-depends in your .cabal file." + -- MP: This is ghci specific, remove + | otherwise + = text "You can run" <+> + quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> + text "to expose it." $$ + text "(Note: this unloads all the modules in the current scope.)" + pkg_hidden_hint _ Nothing = empty + + mod_hidden pkg = + text "it is a hidden module in the package" <+> quotes (ppr pkg) + + unusable (pkg, reason) + = text "It is a member of the package" + <+> quotes (ppr pkg) + $$ pprReason (text "which is") reason + +mayShowLocations :: Bool -> [FilePath] -> SDoc +mayShowLocations verbose files + | null files = empty + | not verbose = + text "Use -v (or `:set -v` in ghci) " <> + text "to see a list of the files searched for." + | otherwise = + hang (text "Locations searched:") 2 $ vcat (map text files) + +missingInterfaceErrorDiagnostic :: Bool -> MissingInterfaceError -> DecoratedSDoc +missingInterfaceErrorDiagnostic verbose_files reason = + case reason of + BadSourceImport m -> mkSimpleDecorated $ badSourceImport m + MissingDeclInInterface name things -> mkSimpleDecorated $ missingDeclInInterface name things + HomeModError im ml -> mkSimpleDecorated $ homeModError im ml + DynamicHashMismatchError m ml -> mkSimpleDecorated $ dynamicHashMismatchError m ml + CantFindErr us cfi -> mkDecorated . map (pprWithUnitState us) . unDecorated $ cantFindError verbose_files cfi + CantFindInstalledErr cfi -> cantFindError verbose_files cfi + HiModuleNameMismatchWarn m1 m2 -> mkSimpleDecorated $ hiModuleNameMismatchWarn m1 m2 + BadIfaceFile fp mie -> + -- TODO + mkSimpleDecorated (text fp) + `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie + FailedToLoadDynamicInterface wanted_mod err -> + mkSimpleDecorated (text "Failed to load dynamic interface file for" <+> ppr wanted_mod) + `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files err + GenericException se -> +-- mkSimpleDecorated $ text "Exception when reading interface file for" <+> ppr mod + mkSimpleDecorated $ text (showException se) + CantFindLocalName name -> mkSimpleDecorated (text "Can't find local name: " <+> ppr name) + CantFindHiInterfaceForSig isig_mod mie -> + mkSimpleDecorated (text "Could not find hi interface for signature" <+> quotes (ppr isig_mod)) + `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie + CantFindHiBoot m mie -> + mkSimpleDecorated (text "Could not find hi-boot interface for" <+> quotes (ppr m)) + `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie + InterfaceLookupError _ mie -> missingInterfaceErrorDiagnostic verbose_files mie + +hiModuleNameMismatchWarn :: Module -> Module -> SDoc +hiModuleNameMismatchWarn requested_mod read_mod + | moduleUnit requested_mod == moduleUnit read_mod = + sep [text "Interface file contains module" <+> quotes (ppr read_mod) <> comma, + text "but we were expecting module" <+> quotes (ppr requested_mod), + sep [text "Probable cause: the source code which generated interface file", + text "has an incompatible module name" + ] + ] + | otherwise = + -- ToDo: This will fail to have enough qualification when the package IDs + -- are the same + withPprStyle (mkUserStyle alwaysQualify AllTheWay) $ + -- we want the Modules below to be qualified with package names, + -- so reset the NamePprCtx setting. + hsep [ text "Something is amiss; requested module " + , ppr requested_mod + , text "differs from name found in the interface file" + , ppr read_mod + , parens (text "if these names look the same, try again with -dppr-debug") + ] + +dynamicHashMismatchError :: Module -> ModLocation -> SDoc +dynamicHashMismatchError wanted_mod loc = + vcat [ text "Dynamic hash doesn't match for" <+> quotes (ppr wanted_mod) + , text "Normal interface file from" <+> text (ml_hi_file loc) + , text "Dynamic interface file from" <+> text (ml_dyn_hi_file loc) + , text "You probably need to recompile" <+> quotes (ppr wanted_mod) ] + +homeModError :: InstalledModule -> ModLocation -> SDoc +-- See Note [Home module load error] +homeModError mod location + = text "attempting to use module " <> quotes (ppr mod) + <> (case ml_hs_file location of + Just file -> space <> parens (text file) + Nothing -> empty) + <+> text "which is not loaded" + + +missingDeclInInterface :: Name -> [TyThing] -> SDoc +missingDeclInInterface name things = + whenPprDebug (found_things $$ empty) $$ + hang (text "Can't find interface-file declaration for" <+> + pprNameSpace (nameNameSpace name) <+> ppr name) + 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", + text "Use -ddump-if-trace to get an idea of which file caused the error"]) + where + found_things = + hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon) + 2 (vcat (map ppr things)) + +badSourceImport :: Module -> SDoc +badSourceImport mod + = hang (text "You cannot {-# SOURCE #-} import a module from another package") + 2 (text "but" <+> quotes (ppr mod) <+> text "is from package" + <+> quotes (ppr (moduleUnit mod))) + deriveInstanceErrReasonHints :: Class -> UsingGeneralizedNewtypeDeriving -> DeriveInstanceErrReason ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -48,6 +48,13 @@ module GHC.Tc.Errors.Types ( , HsDocContext(..) , FixedRuntimeRepErrorInfo(..) + , MissingInterfaceError(..) + , CantFindInstalled(..) + , CantFindInstalledReason(..) + , CantFindWhat(..) + + , BuildingCabalPackage(..) + , ErrorItem(..), errorItemOrigin, errorItemEqRel, errorItemPred, errorItemCtLoc , SolverReport(..), SolverReportSupplementary(..) @@ -116,7 +123,7 @@ import GHC.Types.TyThing (TyThing) import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar) import GHC.Types.Var.Env (TidyEnv) import GHC.Types.Var.Set (TyVarSet, VarSet) -import GHC.Unit.Types (Module) +import GHC.Unit.Types (Module, InstalledModule, UnitId, Unit) import GHC.Utils.Outputable import GHC.Core.Class (Class, ClassMinimalDef) import GHC.Core.Coercion.Axiom (CoAxBranch) @@ -129,7 +136,7 @@ import GHC.Core.Predicate (EqRel, predTypeEqRel) import GHC.Core.TyCon (TyCon, TyConFlavour) import GHC.Core.Type (Kind, Type, ThetaType, PredType) import GHC.Driver.Backend (Backend) -import GHC.Unit.State (UnitState) +import GHC.Unit.State (UnitState, ModuleSuggestion, ModuleOrigin, UnusableUnitReason, UnitInfo) import GHC.Types.Basic import GHC.Utils.Misc (capitalise, filterOut) import qualified GHC.LanguageExtensions as LangExt @@ -144,6 +151,7 @@ import GHC.Unit.Module.Warnings (WarningTxt) import qualified Language.Haskell.TH.Syntax as TH import GHC.Generics ( Generic ) +import GHC.Unit.Module.Location {- Note [Migrating TcM Messages] @@ -2546,14 +2554,6 @@ data TcRnMessage where -> !String -- Error body -> TcRnMessage - {-| TcRnInterfaceLookupError is an error resulting from looking up a name in an interface file. - - Example(s): - - Test cases: - -} - TcRnInterfaceLookupError :: !Name -> !SDoc -> TcRnMessage - {- | TcRnUnsatisfiedMinimalDef is a warning that occurs when a class instance is missing methods that are required by the minimal definition. @@ -3178,6 +3178,8 @@ data TcRnMessage where -} TcRnUnknownTyVarsOnRhsOfInjCond :: [Name] -> TcRnMessage + TcRnMissingInterfaceError :: !MissingInterfaceError -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -3596,6 +3598,41 @@ instance Outputable Exported where ppr IsNotExported = text "IsNotExported" ppr IsExported = text "IsExported" +data MissingInterfaceError = + BadSourceImport !Module + | MissingDeclInInterface !Name [TyThing] + | HomeModError !InstalledModule !ModLocation + | DynamicHashMismatchError !Module !ModLocation + | HiModuleNameMismatchWarn Module Module + | CantFindLocalName Name + -- dodgy? + | GenericException SomeException + -- Can't find errors + | CantFindErr !UnitState CantFindInstalled + | CantFindInstalledErr CantFindInstalled + -- Adding context + | BadIfaceFile FilePath MissingInterfaceError + | FailedToLoadDynamicInterface Module MissingInterfaceError + | CantFindHiInterfaceForSig InstalledModule MissingInterfaceError + | CantFindHiBoot Module MissingInterfaceError + | InterfaceLookupError Name MissingInterfaceError + deriving Generic + +data CantFindInstalledReason = NoUnitIdMatching UnitId [UnitInfo] + | MissingPackageFiles UnitId [FilePath] + | MissingPackageWayFiles String UnitId [FilePath] + | ModuleSuggestion [ModuleSuggestion] [FilePath] + | NotAModule + | CouldntFindInFiles [FilePath] + | GenericMissing BuildingCabalPackage [(Unit, Maybe UnitInfo)] [Unit] [(Unit, UnusableUnitReason)] [FilePath] + -- Ambiguous + | MultiplePackages [Unit] + | MultiplePackages2 [(Module, ModuleOrigin)] + deriving Generic + +data CantFindInstalled = CantFindInstalled ModuleName CantFindWhat CantFindInstalledReason deriving Generic + +data CantFindWhat = CantFindModule | CantLoadModule | CantLoadInterface | AmbiguousInterface | AmbigiousModule -------------------------------------------------------------------------------- -- -- Errors used in GHC.Tc.Errors @@ -4419,3 +4456,11 @@ data NonStandardGuards where data RuleLhsErrReason = UnboundVariable RdrName NotInScopeError | IllegalExpression + +-- | Pass to a 'DriverMessage' the information whether or not the +-- '-fbuilding-cabal-package' flag is set. +data BuildingCabalPackage + = YesBuildingCabalPackage + | NoBuildingCabalPackage + deriving Eq + ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2024,7 +2024,7 @@ tcLookupTh name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return (AGlobal thing) - Failed msg -> failWithTc (TcRnInterfaceLookupError name msg) + Failed msg -> failWithTc (TcRnMissingInterfaceError (InterfaceLookupError name msg)) }}}} notInScope :: TH.Name -> TcRnMessage ===================================== compiler/GHC/Tc/Utils/Backpack.hs ===================================== @@ -168,7 +168,7 @@ checkHsigIface tcg_env gr sig_iface -- tcg_env (TODO: but maybe this isn't relevant anymore). r <- tcLookupImported_maybe name case r of - Failed err -> addErr (TcRnInterfaceLookupError name err) + Failed err -> addErr (TcRnMissingInterfaceError (InterfaceLookupError name err)) Succeeded real_thing -> checkHsigDeclM sig_iface sig_thing real_thing -- The hsig did NOT define this function; that means it must @@ -278,7 +278,7 @@ findExtraSigImports hsc_env HsigFile modname = do reqs = requirementMerges unit_state modname holes <- forM reqs $ \(Module iuid mod_name) -> do initIfaceLoad hsc_env - . withException ctx + . withIfaceErr ctx $ moduleFreeHolesPrecise (text "findExtraSigImports") (mkModule (VirtUnit iuid) mod_name) return (uniqDSetToList (unionManyUniqDSets holes)) @@ -563,7 +563,7 @@ mergeSignatures im = fst (getModuleInstantiation m) ctx = initSDocContext dflags defaultUserStyle fmap fst - . withException ctx + . withIfaceErr ctx $ findAndReadIface hsc_env (text "mergeSignatures") im m NotBoot @@ -996,9 +996,11 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do isig_mod sig_mod NotBoot isig_iface <- case mb_isig_iface of Succeeded (iface, _) -> return iface - Failed err -> failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ + Failed err -> failWithTc $ TcRnMissingInterfaceError $ CantFindHiInterfaceForSig isig_mod err + {- hang (text "Could not find hi interface for signature" <+> quotes (ppr isig_mod) <> colon) 4 err + -} -- STEP 3: Check that the implementing interface exports everything -- we need. (Notice we IGNORE the Modules in the AvailInfos.) ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -24,7 +24,7 @@ module GHC.Tc.Utils.Env( tcLookupDataCon, tcLookupPatSyn, tcLookupConLike, tcLookupLocatedGlobalId, tcLookupLocatedTyCon, tcLookupLocatedClass, tcLookupAxiom, - lookupGlobal, lookupGlobal_maybe, ioLookupDataCon, + lookupGlobal, lookupGlobal_maybe, addTypecheckedBinds, -- Local environment @@ -136,6 +136,8 @@ import Data.IORef import Data.List (intercalate) import Control.Monad import GHC.Driver.Env.KnotVars +import GHC.Utils.Error (formatBulleted) +import GHC.Driver.Config.Diagnostic (initTcMessageOpts) {- ********************************************************************* * * @@ -151,10 +153,12 @@ lookupGlobal hsc_env name mb_thing <- lookupGlobal_maybe hsc_env name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> pprPanic "lookupGlobal" msg + Failed msg -> + let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts (hsc_dflags hsc_env)) (TcRnMissingInterfaceError msg) + in pprPanic "lookupGlobal" err_txt } -lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing) +lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) -- This may look up an Id that one has previously looked up. -- If so, we are going to read its interface file, and add its bindings -- to the ExternalPackageTable. @@ -166,14 +170,14 @@ lookupGlobal_maybe hsc_env name ; if nameIsLocalOrFrom tcg_semantic_mod name then (return - (Failed (text "Can't find local name: " <+> ppr name))) + (Failed (CantFindLocalName name))) -- Internal names can happen in GHCi else -- Try home package table and external package table lookupImported_maybe hsc_env name } -lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing) +lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) -- Returns (Failed err) if we can't find the interface file for the thing lookupImported_maybe hsc_env name = do { mb_thing <- lookupType hsc_env name @@ -182,7 +186,7 @@ lookupImported_maybe hsc_env name Nothing -> importDecl_maybe hsc_env name } -importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing) +importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) importDecl_maybe hsc_env name | Just thing <- wiredInNameTyThing_maybe name = do { when (needWiredInHomeIface thing) @@ -192,22 +196,6 @@ importDecl_maybe hsc_env name | otherwise = initIfaceLoad hsc_env (importDecl name) -ioLookupDataCon :: HscEnv -> Name -> IO DataCon -ioLookupDataCon hsc_env name = do - mb_thing <- ioLookupDataCon_maybe hsc_env name - case mb_thing of - Succeeded thing -> return thing - Failed msg -> pprPanic "lookupDataConIO" msg - -ioLookupDataCon_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc DataCon) -ioLookupDataCon_maybe hsc_env name = do - thing <- lookupGlobal hsc_env name - return $ case thing of - AConLike (RealDataCon con) -> Succeeded con - _ -> Failed $ - pprTcTyThingCategory (AGlobal thing) <+> quotes (ppr name) <+> - text "used as a data constructor" - addTypecheckedBinds :: TcGblEnv -> [LHsBinds GhcTc] -> TcGblEnv addTypecheckedBinds tcg_env binds | isHsBootOrSig (tcg_src tcg_env) = tcg_env @@ -257,7 +245,7 @@ tcLookupGlobal name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> failWithTc (TcRnInterfaceLookupError name msg) + Failed msg -> failWithTc (TcRnMissingInterfaceError (InterfaceLookupError name msg)) }}} -- Look up only in this module's global env't. Don't look in imports, etc. ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -138,7 +138,7 @@ module GHC.Tc.Utils.Monad( forkM, setImplicitEnvM, - withException, + withException, withIfaceErr, -- * Stuff for cost centres. getCCIndexM, getCCIndexTcM, @@ -663,6 +663,16 @@ withException ctx do_this = do Failed err -> liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx err)) Succeeded result -> return result +withIfaceErr :: MonadIO m => SDocContext -> m (MaybeErr MissingInterfaceError a) -> m a +withIfaceErr ctx do_this = do + r <- do_this + case r of + Failed err -> do + let diag = TcRnMissingInterfaceError err + msg = pprDiagnostic diag + liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx msg)) + Succeeded result -> return result + {- ************************************************************************ * * ===================================== compiler/GHC/Types/Error.hs ===================================== @@ -35,6 +35,8 @@ module GHC.Types.Error , mkDecoratedDiagnostic , mkDecoratedError + , pprDiagnostic + , NoDiagnosticOpts(..) -- * Hints and refactoring actions ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -583,6 +583,33 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "OneArgExpected" = 91490 GhcDiagnosticCode "AtLeastOneArgExpected" = 07641 + -- Missing interface errors + GhcDiagnosticCode "BadSourceImport" = 00001 + GhcDiagnosticCode "MissingDeclInInterface" = 00002 + GhcDiagnosticCode "MissingInterfaceError" = 00003 + GhcDiagnosticCode "HomeModError" = 00004 + GhcDiagnosticCode "DynamicHashMismatchError" = 00005 + GhcDiagnosticCode "BadIfaceFile" = 00006 + GhcDiagnosticCode "CantFindLocalName" = 00009 + GhcDiagnosticCode "FailedToLoadDynamicInterface" = 00010 + GhcDiagnosticCode "GenericException" = 00011 + GhcDiagnosticCode "HiModuleNameMismatch" = 00012 + GhcDiagnosticCode "HiModuleNameMismatchWarn" = 00013 + GhcDiagnosticCode "UsedAsDataConstructor" = 00014 + GhcDiagnosticCode "CantFindHiInterfaceForSig" = 00015 + + GhcDiagnosticCode "CouldntFindInFiles" = 00016 + GhcDiagnosticCode "GenericMissing" = 00017 + GhcDiagnosticCode "MissingPackageFiles" = 00018 + GhcDiagnosticCode "MissingPackageWayFiles" = 00019 + GhcDiagnosticCode "ModuleSuggestion" = 00020 + GhcDiagnosticCode "MultiplePackages" = 00021 + GhcDiagnosticCode "MultiplePackages2" = 00022 + GhcDiagnosticCode "NoUnitIdMatching" = 00023 + GhcDiagnosticCode "NotAModule" = 00024 + GhcDiagnosticCode "CantFindHiBoot" = 00025 + + -- Out of scope errors GhcDiagnosticCode "NotInScope" = 76037 GhcDiagnosticCode "NoExactName" = 97784 @@ -670,6 +697,18 @@ type family ConRecursInto con where ConRecursInto "DriverUnknownMessage" = 'Just UnknownDiagnostic ConRecursInto "DriverPsHeaderMessage" = 'Just PsMessage + ConRecursInto "DriverInterfaceError" = 'Just MissingInterfaceError + + ConRecursInto "CantFindErr" = 'Just CantFindInstalled + ConRecursInto "CantFindInstalledErr" = 'Just CantFindInstalled + + ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason + + ConRecursInto "BadIfaceFile" = 'Just MissingInterfaceError + ConRecursInto "FailedToLoadDynamicInterface" = 'Just MissingInterfaceError + ConRecursInto "CantFindHiInterfaceForSig" = 'Just MissingInterfaceError + ConRecursInto "CantFindHiBoot" = 'Just MissingInterfaceError + ConRecursInto "InterfaceLookupError" = 'Just MissingInterfaceError ---------------------------------- -- Constructors of PsMessage @@ -698,6 +737,8 @@ type family ConRecursInto con where ConRecursInto "TcRnRunSpliceFailure" = 'Just RunSpliceFailReason ConRecursInto "ConversionFail" = 'Just ConversionFailReason + ConRecursInto "TcRnMissingInterfaceError" = 'Just MissingInterfaceError + ------------------ -- FFI errors ===================================== compiler/GHC/Utils/Error.hs ===================================== @@ -219,14 +219,14 @@ getInvalids vs = [d | NotValid d <- vs] ---------------- -- | Formats the input list of structured document, where each element of the list gets a bullet. -formatBulleted :: SDocContext -> DecoratedSDoc -> SDoc -formatBulleted ctx (unDecorated -> docs) - = case msgs of +formatBulleted :: DecoratedSDoc -> SDoc +formatBulleted (unDecorated -> docs) + = sdocWithContext $ \ctx -> case msgs ctx of [] -> Outputable.empty [msg] -> msg - _ -> vcat $ map starred msgs + xs -> vcat $ map starred xs where - msgs = filter (not . Outputable.isEmpty ctx) docs + msgs ctx = filter (not . Outputable.isEmpty ctx) docs starred = (bullet<+>) pprMessages :: Diagnostic e => DiagnosticOpts e -> Messages e -> SDoc @@ -248,12 +248,11 @@ pprLocMsgEnvelope opts (MsgEnvelope { errMsgSpan = s , errMsgDiagnostic = e , errMsgSeverity = sev , errMsgContext = name_ppr_ctx }) - = sdocWithContext $ \ctx -> - withErrStyle name_ppr_ctx $ + = withErrStyle name_ppr_ctx $ mkLocMessage (MCDiagnostic sev (diagnosticReason e) (diagnosticCode e)) s - (formatBulleted ctx $ diagnosticMessage opts e) + (formatBulleted $ diagnosticMessage opts e) sortMsgBag :: Maybe DiagOpts -> Bag (MsgEnvelope e) -> [MsgEnvelope e] sortMsgBag mopts = maybeLimit . sortBy (cmp `on` errMsgSpan) . bagToList ===================================== ghc/GHCi/UI.hs ===================================== @@ -35,6 +35,7 @@ import qualified GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls' ) import GHCi.UI.Monad hiding ( args, runStmt ) import GHCi.UI.Tags import GHCi.UI.Info +import GHCi.UI.Exception import GHC.Runtime.Debugger -- The GHC interface @@ -1115,7 +1116,7 @@ runOneCommand eh gCmd = do -- is the handler necessary here? where printErrorAndFail err = do - GHC.printException err + printGhciException err return $ Just False -- Exit ghc -e, but not GHCi noSpace q = q >>= maybe (return Nothing) @@ -1588,7 +1589,7 @@ help _ = do info :: GHC.GhcMonad m => Bool -> String -> m () info _ "" = throwGhcException (CmdLineError "syntax: ':i '") -info allInfo s = handleSourceError GHC.printException $ do +info allInfo s = handleSourceError printGhciException $ do forM_ (words s) $ \thing -> do sdoc <- infoThing allInfo thing rendered <- showSDocForUser' sdoc @@ -2002,7 +2003,7 @@ instancesCmd :: String -> InputT GHCi () instancesCmd "" = throwGhcException (CmdLineError "syntax: ':instances '") instancesCmd s = do - handleSourceError GHC.printException $ do + handleSourceError printGhciException $ do ty <- GHC.parseInstanceHead s res <- GHC.getInstancesForType ty @@ -2309,7 +2310,7 @@ modulesLoadedMsg ok mods = do -- and printing 'throwE' strings to 'stderr'. If in expression -- evaluation mode - throw GhcException and exit. runExceptGhciMonad :: GhciMonad m => ExceptT SDoc m () -> m () -runExceptGhciMonad act = handleSourceError GHC.printException $ +runExceptGhciMonad act = handleSourceError printGhciException $ either handleErr pure =<< runExceptT act where @@ -4543,7 +4544,7 @@ failIfExprEvalMode = do -- | When in expression evaluation mode (ghc -e), we want to exit immediately. -- Otherwis, just print out the message. printErrAndMaybeExit :: (GhciMonad m, MonadIO m, HasLogger m) => SourceError -> m () -printErrAndMaybeExit = (>> failIfExprEvalMode) . GHC.printException +printErrAndMaybeExit = (>> failIfExprEvalMode) . printGhciException ----------------------------------------------------------------------------- -- recursive exception handlers @@ -4641,7 +4642,7 @@ wantNameFromInterpretedModule :: GHC.GhcMonad m -> (Name -> m ()) -> m () wantNameFromInterpretedModule noCanDo str and_then = - handleSourceError GHC.printException $ do + handleSourceError printGhciException $ do n NE.:| _ <- GHC.parseName str let modl = assert (isExternalName n) $ GHC.nameModule n if not (GHC.isExternalName n) ===================================== ghc/GHCi/UI/Exception.hs ===================================== @@ -0,0 +1,42 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module GHCi.UI.Exception(printGhciException) where + +import GHC.Prelude +import GHC.Utils.Logger +import Control.Monad.IO.Class +import GHC.Driver.Session +import GHC.Types.SourceError +import GHC.Driver.Errors.Types +import GHC.Types.Error +import GHC.Driver.Config.Diagnostic +import GHC.Driver.Errors + +-- | Print the all diagnostics in a 'SourceError'. Specialised for GHCi error reporting +-- for some error messages. +printGhciException :: (HasLogger m, MonadIO m, HasDynFlags m) => SourceError -> m () +printGhciException err = do + dflags <- getDynFlags + logger <- getLogger + let !diag_opts = initDiagOpts dflags + !print_config = initPrintConfig dflags + liftIO $ printMessages logger print_config diag_opts (GHCiMessage <$> (srcErrorMessages err)) + + +newtype GHCiMessage = GHCiMessage { getGhciMessage :: GhcMessage } + +instance Diagnostic GHCiMessage where + type DiagnosticOpts GHCiMessage = DiagnosticOpts GhcMessage + + defaultDiagnosticOpts = defaultDiagnosticOpts @GhcMessage + + diagnosticMessage opts (GHCiMessage msg) = diagnosticMessage opts msg + + diagnosticReason (GHCiMessage msg) = diagnosticReason msg + + diagnosticHints (GHCiMessage msg) = diagnosticHints msg + + diagnosticCode (GHCiMessage msg) = diagnosticCode msg + + ===================================== ghc/Main.hs ===================================== @@ -98,6 +98,8 @@ import GHC.ResponseFile (expandResponse) import Data.Bifunctor import GHC.Data.Graph.Directed import qualified Data.List.NonEmpty as NE +import GHC.Types.Error +import GHC.Tc.Errors.Types (TcRnMessage(..)) ----------------------------------------------------------------------------- -- ToDo: @@ -1100,8 +1102,9 @@ abiHash strs = do r <- findImportedModule hsc_env modname NoPkgQual case r of Found _ m -> return m - _error -> throwGhcException $ CmdLineError $ showSDoc dflags $ - cannotFindModule hsc_env modname r + _error -> + let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError (cannotFindModule hsc_env modname r)) + in throwGhcException . CmdLineError $ showSDoc dflags err_txt mods <- mapM find_it strs ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -69,6 +69,7 @@ Executable ghc GHCi.UI.Info GHCi.UI.Monad GHCi.UI.Tags + GHCi.UI.Exception GHCi.Util Other-Extensions: FlexibleInstances View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/93c56386f13072bb7e58c5981e807426e6eb4f8e...4c2bf582af0931c41c86e8210bbfcccdf785f951 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/93c56386f13072bb7e58c5981e807426e6eb4f8e...4c2bf582af0931c41c86e8210bbfcccdf785f951 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 13:14:51 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 15 Mar 2023 09:14:51 -0400 Subject: [Git][ghc/ghc][wip/js-th] 69 commits: Add `Data.Functor.unzip` Message-ID: <6411c4cb56d0b_37e76b1f356fdc2878f2@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - 53002b0d by Sylvain Henry at 2023-03-15T14:19:29+01:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 20 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Runtime/Interpreter.hs - + compiler/GHC/Runtime/Interpreter/JS.hs - + compiler/GHC/Runtime/Interpreter/Process.hs - compiler/GHC/Runtime/Interpreter/Types.hs - + compiler/GHC/Runtime/Utils.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Linker/Linker.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/239bdf3194fe6275f9329378fb05507cb9af0f7b...53002b0d352437ab6bc6e0258175a2d5bc6bfbe2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/239bdf3194fe6275f9329378fb05507cb9af0f7b...53002b0d352437ab6bc6e0258175a2d5bc6bfbe2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 13:35:24 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 15 Mar 2023 09:35:24 -0400 Subject: [Git][ghc/ghc][wip/js-th] JS: implement TH support Message-ID: <6411c99c5a91e_37e76b1fc9e1e43043ac@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 8141271d by Sylvain Henry at 2023-03-15T14:40:03+01:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Runtime/Interpreter.hs - + compiler/GHC/Runtime/Interpreter/JS.hs - + compiler/GHC/Runtime/Interpreter/Process.hs - compiler/GHC/Runtime/Interpreter/Types.hs - + compiler/GHC/Runtime/Utils.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Types.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/ghc.cabal.in - + ghc-interp.js - hadrian/src/Base.hs - hadrian/src/Rules/Generate.hs - libraries/base/System/Posix/Internals.hs - libraries/base/jsbits/base.js - libraries/ghci/GHCi/RemoteTypes.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - libraries/template-haskell/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/annotations/should_compile/all.T - testsuite/tests/annotations/should_fail/all.T - testsuite/tests/annotations/should_run/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8141271d68e9befbb3952930cf2cc4ee5cd48ac4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8141271d68e9befbb3952930cf2cc4ee5cd48ac4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 15:34:27 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 15 Mar 2023 11:34:27 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] 2 commits: Hardwire a better unit-id for ghc Message-ID: <6411e58351b04_37e76b21c918c031173@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 49a43ba3 by romes at 2023-03-15T15:33:47+00:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 74411c8b by romes at 2023-03-15T15:34:16+00:00 Validate compatibility of ghcs when loading plugins - - - - - 10 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Packages.hs - testsuite/tests/driver/j-space/jspace.hs - utils/count-deps/Main.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4703,6 +4703,7 @@ compilerInfo dflags ("Project Patch Level", cProjectPatchLevel), ("Project Patch Level1", cProjectPatchLevel1), ("Project Patch Level2", cProjectPatchLevel2), + ("Project Unit Id", cProjectUnitId), ("Booter version", cBooterVersion), ("Stage", cStage), ("Build platform", cBuildPlatformString), ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -42,10 +42,10 @@ import GHC.Driver.Env import GHCi.RemoteTypes ( HValue ) import GHC.Core.Type ( Type, mkTyConTy ) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.TyCon ( TyCon ) +import GHC.Core.TyCon ( TyCon(tyConName) ) import GHC.Types.SrcLoc ( noSrcSpan ) -import GHC.Types.Name ( Name, nameModule_maybe ) +import GHC.Types.Name ( Name, nameModule, nameModule_maybe ) import GHC.Types.Id ( idType ) import GHC.Types.TyThing import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS ) @@ -55,7 +55,7 @@ import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) import GHC.Driver.Config.Finder ( initFinderOpts ) -import GHC.Unit.Module ( Module, ModuleName ) +import GHC.Unit.Module ( Module, ModuleName, thisGhcUnit, GenModule(moduleUnit) ) import GHC.Unit.Module.ModIface import GHC.Unit.Env @@ -171,7 +171,14 @@ loadPlugin' occ_name plugin_name hsc_env mod_name Just (name, mod_iface) -> do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name - ; eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) + ; case thisGhcUnit == (moduleUnit . nameModule . tyConName) plugin_tycon of { + False -> + throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep + [ text "The plugin module", ppr mod_name + , text "was built with a compiler that is incompatible with the one loading it" + ]) ; + True -> + do { eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) ; case eith_plugin of Left actual_type -> throwGhcExceptionIO (CmdLineError $ @@ -182,7 +189,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name , text "did not have the type" , text "GHC.Plugins.Plugin" , text "as required"]) - Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } + Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } } } -- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -99,6 +99,7 @@ import GHC.Data.FastString import GHC.Utils.Encoding import GHC.Utils.Fingerprint import GHC.Utils.Misc +import GHC.Settings.Config (cProjectUnitId) import Control.DeepSeq import Data.Data @@ -597,7 +598,7 @@ primUnitId = UnitId (fsLit "ghc-prim") bignumUnitId = UnitId (fsLit "ghc-bignum") baseUnitId = UnitId (fsLit "base") rtsUnitId = UnitId (fsLit "rts") -thisGhcUnitId = UnitId (fsLit "ghc") +thisGhcUnitId = UnitId (fsLit cProjectUnitId) interactiveUnitId = UnitId (fsLit "interactive") thUnitId = UnitId (fsLit "template-haskell") @@ -625,8 +626,15 @@ wiredInUnitIds = , baseUnitId , rtsUnitId , thUnitId - , thisGhcUnitId ] + -- NB: ghc is no longer part of the wired-in units since its unit-id, given + -- by hadrian or cabal, is no longer overwritten and now matches both the + -- cProjectUnitId defined in build-time-generated module GHC.Version, and + -- the unit key. + -- + -- See also Note [About units], taking into consideration ghc is still a + -- wired-in unit but whose unit-id no longer needs special handling because + -- we take care that it matches the unit key. --------------------------------------------------------------------- -- Boot Modules ===================================== compiler/Setup.hs ===================================== @@ -3,7 +3,10 @@ module Main where import Distribution.Simple import Distribution.Simple.BuildPaths +import Distribution.Types.ComponentLocalBuildInfo +import Distribution.Types.ComponentName (ComponentName(CLibName)) import Distribution.Types.LocalBuildInfo +import Distribution.Types.LibraryName (LibraryName(LMainLibName)) import Distribution.Verbosity import Distribution.Simple.Program import Distribution.Simple.Utils @@ -15,6 +18,7 @@ import System.Directory import System.FilePath import Control.Monad import Data.Char +import qualified Data.Map as Map import GHC.ResponseFile import System.Environment @@ -85,9 +89,13 @@ ghcAutogen verbosity lbi at LocalBuildInfo{..} = do callProcess "deriveConstants" ["--gen-haskell-type","-o",tmp,"--target-os",targetOS] renameFile tmp platformConstantsPath + let cProjectUnitId = case Map.lookup (CLibName LMainLibName) componentNameMap of + Just [LibComponentLocalBuildInfo{componentUnitId}] -> unUnitId componentUnitId + _ -> error "Couldn't find unique cabal library when building ghc" + -- Write GHC.Settings.Config - let configHsPath = autogenPackageModulesDir lbi "GHC/Settings/Config.hs" - configHs = generateConfigHs settings + configHsPath = autogenPackageModulesDir lbi "GHC/Settings/Config.hs" + configHs = generateConfigHs cProjectUnitId settings createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath) rewriteFileEx verbosity configHsPath configHs @@ -98,8 +106,9 @@ getSetting settings kh kr = go settings kr Nothing -> Left (show k ++ " not found in settings: " ++ show settings) Just v -> Right v -generateConfigHs :: [(String,String)] -> String -generateConfigHs settings = either error id $ do +generateConfigHs :: String -- ^ ghc's cabal-generated unit-id, which matches its package-id/key + -> [(String,String)] -> String +generateConfigHs cProjectUnitId settings = either error id $ do let getSetting' = getSetting $ (("cStage","2"):) settings buildPlatform <- getSetting' "cBuildPlatformString" "Host platform" hostPlatform <- getSetting' "cHostPlatformString" "Target platform" @@ -114,6 +123,7 @@ generateConfigHs settings = either error id $ do , " , cProjectName" , " , cBooterVersion" , " , cStage" + , " , cProjectUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -134,4 +144,7 @@ generateConfigHs settings = either error id $ do , "" , "cStage :: String" , "cStage = show ("++ cStage ++ " :: Int)" + , "" + , "cProjectUnitId :: String" + , "cProjectUnitId = " ++ show cProjectUnitId ] ===================================== compiler/ghc.cabal.in ===================================== @@ -39,7 +39,7 @@ extra-source-files: custom-setup - setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.10, directory, process, filepath + setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.10, directory, process, filepath, containers Flag internal-interpreter Description: Build with internal interpreter support. @@ -57,6 +57,12 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +-- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` +Flag hadrian-stage0 + Description: Enable if compiling the stage0 compiler with hadrian + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -136,9 +142,10 @@ Library Include-Dirs: . - -- We need to set the unit id to ghc (without a version number) - -- as it's magic. - GHC-Options: -this-unit-id ghc + if flag(hadrian-stage0) + -- We need to set the unit id to ghc (without a version number) + -- as it's magic. + GHC-Options: -this-unit-id ghc c-sources: cbits/cutils.c ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -486,6 +486,15 @@ generateConfigHs = do trackGenerateHs cProjectName <- getSetting ProjectName cBooterVersion <- getSetting GhcVersion + cProjectVersionMunged <- getSetting ProjectVersionMunged + -- ROMES:TODO:HASH First we attempt a fixed unit-id with version but without hash. + -- + -- We now use a more informative unit-id for ghc. See Note [TODO:GHC-UNITID] + -- + -- It's crucial that the unit-id matches the unit-key -- ghc is no longer + -- part of the WiringMap, so we don't to go back and forth between the + -- unit-id and the unit-key -- we take care here that they are the same. + let cProjectUnitId = "ghc-" ++ cProjectVersionMunged -- ROMES:TODO:HASH return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -494,6 +503,7 @@ generateConfigHs = do , " , cProjectName" , " , cBooterVersion" , " , cStage" + , " , cProjectUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -514,6 +524,9 @@ generateConfigHs = do , "" , "cStage :: String" , "cStage = show (" ++ stageString stage ++ " :: Int)" + , "" + , "cProjectUnitId :: String" + , "cProjectUnitId = " ++ show cProjectUnitId ] where stageString (Stage0 InTreeLibs) = "1" @@ -533,6 +546,7 @@ generateVersionHs = do cProjectPatchLevel <- getSetting ProjectPatchLevel cProjectPatchLevel1 <- getSetting ProjectPatchLevel1 cProjectPatchLevel2 <- getSetting ProjectPatchLevel2 + return $ unlines [ "module GHC.Version where" , "" ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -247,6 +247,16 @@ packageGhcArgs :: Args packageGhcArgs = do package <- getPackage ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) + -- ROMES: Until the boot compiler no longer needs ghc's + -- unit-id to be "ghc", the stage0 compiler must be built + -- with `-this-unit-id ghc`, while the wired-in unit-id of + -- ghc is correctly set to the unit-id we'll generate for + -- stage1 (set in generateVersionHs in Rules.Generate). + -- + -- However, we don't need to set the unit-id of "ghc" to "ghc" when + -- building stage0 because we have a flag in compiler/ghc.cabal.in that is + -- sets `-this-unit-id ghc` when hadrian is building stage0, which will + -- overwrite this one. pkgId <- expr $ pkgIdentifier package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -77,6 +77,11 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + -- ROMES: While the boot compiler is not updated wrt -this-unit-id + -- not being fixed to `ghc`, when building stage0, we must set + -- -this-unit-id to `ghc` because the boot compiler expects that. + -- We do it through a cabal flag in ghc.cabal + , stage0 ? arg "+hadrian-stage0" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] ===================================== testsuite/tests/driver/j-space/jspace.hs ===================================== @@ -2,6 +2,7 @@ module Main where import GHC import GHC.Driver.Monad +import GHC.Driver.Session import System.Environment import GHC.Driver.Env.Types import GHC.Profiling @@ -25,6 +26,9 @@ initGhcM xs = do let cmdOpts = ["-fforce-recomp"] ++ xs (df2, leftovers, _) <- parseDynamicFlags (hsc_logger session) df1 (map noLoc cmdOpts) setSessionDynFlags df2 + ghcUnitId <- case lookup "Project Unit Id" (compilerInfo df2) of + Nothing -> fail "failed to find ghc's unit-id in the compiler info" + Just ghcUnitId -> pure ghcUnitId ts <- mapM (\s -> guessTarget s Nothing Nothing) $ map unLoc leftovers setTargets ts _ <- load LoadAllTargets @@ -36,7 +40,7 @@ initGhcM xs = do liftIO $ do requestHeapCensus performGC - [ys] <- filter (isPrefixOf "ghc:GHC.Unit.Module.ModDetails.ModDetails") . lines <$> readFile "jspace.hp" + [ys] <- filter (isPrefixOf (ghcUnitId <> ":GHC.Unit.Module.ModDetails.ModDetails")) . lines <$> readFile "jspace.hp" let (n :: Int) = read (last (words ys)) -- The output should be 50 * 8 * word_size (i.e. 3200, or 1600 on 32-bit architectures): -- the test contains DEPTH + WIDTH + 2 = 50 modules J, H_0, .., H_DEPTH, W_1, .., W_WIDTH, ===================================== utils/count-deps/Main.hs ===================================== @@ -56,25 +56,28 @@ calcDeps modName libdir = logger <- getLogger (df, _, _) <- parseDynamicFlags logger df [noLoc "-package=ghc"] setSessionDynFlags df - env <- getSession - loop env Map.empty [mkModuleName modName] + case lookup "Project Unit Id" (compilerInfo df) of + Nothing -> fail "failed to find ghc's unit-id in the compiler info" + Just ghcUnitId -> do + env <- getSession + loop ghcUnitId env Map.empty [mkModuleName modName] where -- Source imports are only guaranteed to show up in the 'mi_deps' -- of modules that import them directly and don’t propagate -- transitively so we loop. - loop :: HscEnv -> Map.Map ModuleName [ModuleName] -> [ModuleName] -> Ghc (Map.Map ModuleName [ModuleName]) - loop env modules (m : ms) = + loop :: String -> HscEnv -> Map.Map ModuleName [ModuleName] -> [ModuleName] -> Ghc (Map.Map ModuleName [ModuleName]) + loop ghcUnitId env modules (m : ms) = if m `Map.member` modules - then loop env modules ms + then loop ghcUnitId env modules ms else do - mi <- liftIO $ hscGetModuleInterface env (mkModule m) + mi <- liftIO $ hscGetModuleInterface env (mkModule ghcUnitId m) let deps = modDeps mi modules <- return $ Map.insert m [] modules - loop env (Map.insert m deps modules) $ ms ++ filter (not . (`Map.member` modules)) deps - loop _ modules [] = return modules + loop ghcUnitId env (Map.insert m deps modules) $ ms ++ filter (not . (`Map.member` modules)) deps + loop _ _ modules [] = return modules - mkModule :: ModuleName -> Module - mkModule = Module (stringToUnit "ghc") + mkModule :: String -> ModuleName -> Module + mkModule ghcUnitId = Module (stringToUnit ghcUnitId) modDeps :: ModIface -> [ModuleName] modDeps mi = map (gwib_mod . snd) $ Set.toList $ dep_direct_mods (mi_deps mi) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0aa3abb8a6ab4315c9d4ea301bf09c9915f59778...74411c8bbaf14398b965259e6ea8b8838d92b579 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0aa3abb8a6ab4315c9d4ea301bf09c9915f59778...74411c8bbaf14398b965259e6ea8b8838d92b579 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 15:40:08 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Wed, 15 Mar 2023 11:40:08 -0400 Subject: [Git][ghc/ghc][wip/interface-loading-errs] refactor interface error datatypes Message-ID: <6411e6d89b9ea_37e76b21e604f8312123@gitlab.mail> sheaf pushed to branch wip/interface-loading-errs at Glasgow Haskell Compiler / GHC Commits: bd925623 by sheaf at 2023-03-15T16:39:51+01:00 refactor interface error datatypes - - - - - 16 changed files: - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Tidy.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error/Codes.hs Changes: ===================================== compiler/GHC/Driver/Config/Diagnostic.hs ===================================== @@ -49,8 +49,9 @@ initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage initPsMessageOpts _ = NoDiagnosticOpts initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage -initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags - , tcOptsShowTriedFiles = verbosity dflags >= 3 } +initTcMessageOpts dflags = + TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags + , tcOptsShowTriedFiles = verbosity dflags >= 3 } initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage initDsMessageOpts _ = NoDiagnosticOpts ===================================== compiler/GHC/Driver/Config/Tidy.hs ===================================== @@ -28,7 +28,6 @@ import GHC.Platform.Ways import qualified GHC.LanguageExtensions as LangExt import GHC.Types.Error import GHC.Utils.Error -import GHC.Tc.Errors.Types (TcRnMessage(..)) import GHC.Driver.Config.Diagnostic (initTcMessageOpts) initTidyOpts :: HscEnv -> IO TidyOpts @@ -56,11 +55,10 @@ initStaticPtrOpts hsc_env = do let lookupM n = lookupGlobal_maybe hsc_env n >>= \case Succeeded r -> pure r Failed err -> - let txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError err) + let txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) err in pprPanic "initStaticPtrOpts: couldn't find" (ppr (txt, n)) - mk_string <- getMkStringIds (fmap tyThingId . lookupM) static_ptr_info_datacon <- tyThingDataCon <$> lookupM staticPtrInfoDataConName static_ptr_datacon <- tyThingDataCon <$> lookupM staticPtrDataConName ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -16,7 +16,7 @@ import GHC.Driver.Flags import GHC.Driver.Session import GHC.HsToCore.Errors.Ppr () import GHC.Parser.Errors.Ppr () -import GHC.Tc.Errors.Ppr (missingInterfaceErrorHints, missingInterfaceErrorReason, missingInterfaceErrorDiagnostic) +import GHC.Tc.Errors.Ppr import GHC.Types.Error import GHC.Types.Error.Codes ( constructorCode ) import GHC.Unit.Types ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -16,28 +16,26 @@ import GHC.Driver.Env import GHC.Driver.Errors.Types import GHC.Data.Maybe import GHC.Prelude +import GHC.Tc.Errors.Types import GHC.Unit import GHC.Unit.Env import GHC.Unit.Finder.Types import GHC.Utils.Outputable as Outputable -import GHC.Tc.Errors.Types (MissingInterfaceError (..), CantFindInstalled(..), CantFindInstalledReason(..), CantFindWhat(..), BuildingCabalPackage) +-- ----------------------------------------------------------------------------- +-- Error messages badIfaceFile :: String -> SDoc -> SDoc badIfaceFile file err = vcat [text "Bad interface file:" <+> text file, nest 4 err] - - - --- ----------------------------------------------------------------------------- --- Error messages - -cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile -> ModuleName -> InstalledFindResult -> MissingInterfaceError -cannotFindInterface us mhu p mn ifr = CantFindInstalledErr (cantFindInstalledErr CantLoadInterface - AmbiguousInterface us mhu p mn ifr) - +cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile + -> ModuleName -> InstalledFindResult -> MissingInterfaceError +cannotFindInterface us mhu p mn ifr = + CantFindInstalledErr $ + cantFindInstalledErr CantLoadInterface + AmbiguousInterface us mhu p mn ifr cantFindInstalledErr :: CantFindWhat @@ -96,11 +94,13 @@ cannotFindModule hsc_env = cannotFindModule' (targetProfile (hsc_dflags hsc_env)) -cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> MissingInterfaceError -cannotFindModule' dflags unit_env profile mod res = CantFindErr (ue_units unit_env) $ +cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult + -> MissingInterfaceError +cannotFindModule' dflags unit_env profile mod res = + CantFindErr (ue_units unit_env) $ cantFindErr (checkBuildingCabalPackage dflags) cannotFindMsg - AmbigiousModule + AmbiguousModule unit_env profile mod @@ -125,15 +125,7 @@ cantFindErr -> FindResult -> CantFindInstalled cantFindErr _ _ multiple_found _ _ mod_name (FoundMultiple mods) - | Just pkgs <- unambiguousPackages - = CantFindInstalled mod_name multiple_found (MultiplePackages pkgs) - | otherwise - = CantFindInstalled mod_name multiple_found (MultiplePackages2 mods) - where - unambiguousPackages = foldl' unambiguousPackage (Just []) mods - unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) - = Just (moduleUnit m : xs) - unambiguousPackage _ _ = Nothing + = CantFindInstalled mod_name multiple_found (MultiplePackages mods) cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result = CantFindInstalled mod_name cannot_find more_info @@ -163,7 +155,9 @@ cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result -> NotAModule | otherwise - -> GenericMissing using_cabal (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) mod_hiddens unusables files + -> GenericMissing using_cabal + (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) + mod_hiddens unusables files _ -> panic "cantFindErr" build_tag = waysBuildTag (profileWays profile) @@ -177,4 +171,4 @@ cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result MissingPackageWayFiles build pkg files | otherwise - = MissingPackageFiles pkg files \ No newline at end of file + = MissingPackageFiles pkg files ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -143,7 +143,7 @@ where the code that e1 expands to might import some defns that also turn out to be needed by the code that e2 expands to. -} -tcLookupImported_maybe :: Name -> TcM (MaybeErr MissingInterfaceError TyThing) +tcLookupImported_maybe :: Name -> TcM (MaybeErr InterfaceError TyThing) -- Returns (Failed err) if we can't find the interface file for the thing tcLookupImported_maybe name = do { hsc_env <- getTopEnv @@ -152,7 +152,7 @@ tcLookupImported_maybe name Just thing -> return (Succeeded thing) Nothing -> tcImportDecl_maybe name } -tcImportDecl_maybe :: Name -> TcM (MaybeErr MissingInterfaceError TyThing) +tcImportDecl_maybe :: Name -> TcM (MaybeErr InterfaceError TyThing) -- Entry point for *source-code* uses of importDecl tcImportDecl_maybe name | Just thing <- wiredInNameTyThing_maybe name @@ -163,7 +163,7 @@ tcImportDecl_maybe name | otherwise = initIfaceTcRn (importDecl name) -importDecl :: Name -> IfM lcl (MaybeErr MissingInterfaceError TyThing) +importDecl :: Name -> IfM lcl (MaybeErr InterfaceError TyThing) -- Get the TyThing for this Name from an interface file -- It's not a wired-in thing -- the caller caught that importDecl name @@ -174,15 +174,18 @@ importDecl name -- Load the interface, which should populate the PTE ; mb_iface <- assertPpr (isExternalName name) (ppr name) $ loadInterface nd_doc (nameModule name) ImportBySystem - ; case mb_iface of { - Failed err_msg -> return (Failed err_msg) ; - Succeeded _ -> do + ; case mb_iface of + { Failed err_msg -> return $ Failed $ + Can'tFindInterface err_msg (LookingForName name) + ; Succeeded _ -> do -- Now look it up again; this time we should find it { eps <- getEps ; case lookupTypeEnv (eps_PTE eps) name of Just thing -> return $ Succeeded thing - Nothing -> return $ Failed (MissingDeclInInterface name (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps)) + Nothing -> return $ Failed $ + Can'tFindNameInInterface name + (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps) }}} where nd_doc = text "Need decl for" <+> ppr name @@ -289,8 +292,14 @@ loadSrcInterface :: SDoc loadSrcInterface doc mod want_boot maybe_pkg = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg ; case res of - Failed err -> failWithTc (TcRnMissingInterfaceError err) - Succeeded iface -> return iface } + Failed err -> + failWithTc $ + TcRnInterfaceError $ + Can'tFindInterface err $ + LookingForModule mod want_boot + Succeeded iface -> + return iface + } -- | Like 'loadSrcInterface', but returns a 'MaybeErr'. loadSrcInterface_maybe :: SDoc @@ -886,8 +895,8 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do _ -> do r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc) case r of - Failed _ - -> return r + Failed err + -> return (Failed $ BadIfaceFile err) Succeeded (iface,_fp) -> do r2 <- load_dynamic_too_maybe logger name_cache unit_state @@ -895,7 +904,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do iface loc case r2 of Failed sdoc -> return (Failed sdoc) - Succeeded {} -> return r + Succeeded {} -> return $ Succeeded (iface,_fp) err -> do trace_if logger (text "...not found") return $ Failed $ cannotFindInterface @@ -906,14 +915,18 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do err -- | Check if we need to try the dynamic interface for -dynamic-too -load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ()) +load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> ModIface -> ModLocation + -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc -- Indefinite interfaces are ALWAYS non-dynamic. | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ()) | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc | otherwise = return (Succeeded ()) -load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ()) +load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> ModIface -> ModLocation + -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case Succeeded (dynIface, _) @@ -929,7 +942,9 @@ load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do -read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr MissingInterfaceError (ModIface, FilePath)) +read_file :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> FilePath + -> IO (MaybeErr ReadInterfaceError (ModIface, FilePath)) read_file logger name_cache unit_state dflags wanted_mod file_path = do trace_if logger (text "readIFace" <+> text file_path) @@ -944,7 +959,7 @@ read_file logger name_cache unit_state dflags wanted_mod file_path = do (uninstantiateInstantiatedModule indef_mod) read_result <- readIface dflags name_cache wanted_mod' file_path case read_result of - Failed err -> return (Failed (BadIfaceFile file_path err)) + Failed err -> return (Failed err) Succeeded iface -> return (Succeeded (iface, file_path)) -- Don't forget to fill in the package name... @@ -965,7 +980,7 @@ readIface -> NameCache -> Module -> FilePath - -> IO (MaybeErr MissingInterfaceError ModIface) + -> IO (MaybeErr ReadInterfaceError ModIface) readIface dflags name_cache wanted_mod file_path = do let profile = targetProfile dflags res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path @@ -979,9 +994,9 @@ readIface dflags name_cache wanted_mod file_path = do | otherwise -> return (Failed err) where actual_mod = mi_module iface - err = HiModuleNameMismatchWarn wanted_mod actual_mod + err = HiModuleNameMismatchWarn file_path wanted_mod actual_mod - Left exn -> return (Failed (GenericException exn)) + Left exn -> return (Failed (ExceptionOccurred file_path exn)) {- ********************************************************* ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Iface.Recomp.Flags import GHC.Iface.Env import GHC.Core +import GHC.Tc.Errors.Ppr import GHC.Tc.Utils.Monad import GHC.Hs @@ -83,7 +84,6 @@ import GHC.List (uncons) import Data.Ord import Data.Containers.ListUtils import Data.Bifunctor -import GHC.Tc.Errors.Ppr (missingInterfaceErrorDiagnostic) {- ----------------------------------------------- @@ -293,8 +293,13 @@ check_old_iface hsc_env mod_summary maybe_iface read_result <- readIface read_dflags ncu (ms_mod mod_summary) iface_path case read_result of Failed err -> do - trace_if logger (text "FYI: cannot read old interface file:" $$ nest 4 (formatBulleted $ missingInterfaceErrorDiagnostic False err)) - trace_hi_diffs logger (text "Old interface file was invalid:" $$ nest 4 (formatBulleted $ missingInterfaceErrorDiagnostic False err)) + let blah = readInterfaceErrorDiagnostic err + trace_if logger + $ vcat [ text "FYI: cannot read old interface file:" + , nest 4 (formatBulleted blah) ] + trace_hi_diffs logger $ + vcat [ text "Old interface file was invalid:" + , nest 4 (formatBulleted blah) ] return Nothing Succeeded iface -> do trace_if logger (text "Read the interface file" <+> text iface_path) ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -50,6 +50,7 @@ import GHC.StgToCmm.Types import GHC.Runtime.Heap.Layout import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Ppr import GHC.Tc.TyCl.Build import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType @@ -130,7 +131,7 @@ import GHC.Unit.Module.WholeCoreBindings import Data.IORef import Data.Foldable import GHC.Builtin.Names (ioTyConName, rOOT_MAIN) -import GHC.Tc.Errors.Ppr (missingInterfaceErrorDiagnostic) + import GHC.Utils.Error {- @@ -576,13 +577,14 @@ tcHiBootIface hsc_src mod -- to check consistency against, rather than just when we notice -- that an hi-boot is necessary due to a circular import. { hsc_env <- getTopEnv - ; read_result <- liftIO $ findAndReadIface hsc_env - need (fst (getModuleInstantiation mod)) mod - IsBoot -- Hi-boot file + ; read_result <- liftIO $ findAndReadIface hsc_env need + (fst (getModuleInstantiation mod)) mod + IsBoot -- Hi-boot file ; case read_result of { - Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface - ; mkSelfBootInfo iface tc_iface } ; + Succeeded (iface, _path) -> + do { tc_iface <- initIfaceTcRn $ typecheckIface iface + ; mkSelfBootInfo iface tc_iface } ; Failed err -> -- There was no hi-boot file. But if there is circularity in @@ -598,7 +600,10 @@ tcHiBootIface hsc_src mod Nothing -> return NoSelfBoot -- error cases Just (GWIB { gwib_isBoot = is_boot }) -> case is_boot of - IsBoot -> failWithTc (TcRnMissingInterfaceError (CantFindHiBoot mod err)) + IsBoot -> + let diag = Can'tFindInterface err + (LookingForHiBoot mod) + in failWithTc (TcRnInterfaceError diag) -- The hi-boot file has mysteriously disappeared. NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop) -- Someone below us imported us! @@ -1961,7 +1966,7 @@ tcIfaceGlobal name { mb_thing <- importDecl name -- It's imported; go get it ; case mb_thing of - Failed err -> failIfM (ppr name <+> (formatBulleted $ missingInterfaceErrorDiagnostic False err)) + Failed err -> failIfM (ppr name <+> (formatBulleted $ interfaceErrorDiagnostic False err)) Succeeded thing -> return thing }}} ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -48,6 +48,7 @@ import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Finder import GHC.Tc.Utils.Monad +import GHC.Tc.Errors.Ppr import GHC.Runtime.Interpreter import GHCi.RemoteTypes @@ -120,7 +121,6 @@ import GHC.Iface.Load import GHC.Unit.Home import Data.Either import Control.Applicative -import GHC.Tc.Errors.Types (TcRnMessage(..)) uninitialised :: a uninitialised = panic "Loader not initialised" @@ -792,8 +792,9 @@ getLinkDeps hsc_env pls replace_osuf span mods mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $ loadInterface msg mod (ImportByUser NotBoot) iface <- case mb_iface of - Maybes.Failed err -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError err) + Maybes.Failed err -> + let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags + err_txt = formatBulleted $ missingInterfaceErrorDiagnostic tries err in throwGhcExceptionIO (ProgramError (showSDoc dflags err_txt)) Maybes.Succeeded iface -> return iface ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -44,6 +44,8 @@ import GHC.Core.Type ( Type, mkTyConTy ) import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( TyCon ) +import GHC.Tc.Errors.Ppr + import GHC.Types.SrcLoc ( noSrcSpan ) import GHC.Types.Name ( Name, nameModule_maybe ) import GHC.Types.Id ( idType ) @@ -52,11 +54,13 @@ import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS ) import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName , greMangledName, mkRdrQual ) +import GHC.Types.Unique.DFM import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) import GHC.Driver.Config.Finder ( initFinderOpts ) +import GHC.Driver.Config.Diagnostic ( initTcMessageOpts ) import GHC.Unit.Module ( Module, ModuleName ) -import GHC.Unit.Module.ModIface +import GHC.Unit.Module.ModIface ( ModIface_(mi_exports), ModIface ) import GHC.Unit.Env import GHC.Utils.Panic @@ -69,10 +73,8 @@ import Control.Monad ( unless ) import Data.Maybe ( mapMaybe ) import Unsafe.Coerce ( unsafeCoerce ) import GHC.Linker.Types -import GHC.Types.Unique.DFM import Data.List (unzip4) -import GHC.Tc.Errors.Types (TcRnMessage(..)) -import GHC.Driver.Config.Diagnostic (initTcMessageOpts) + -- | Loads the plugins specified in the pluginModNames field of the dynamic -- flags. Should be called after command line arguments are parsed, but before @@ -331,7 +333,9 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do Nothing -> throwCmdLineErrorS dflags $ hsep [text "Could not determine the exports of the module", ppr mod_name] err -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError (cannotFindModule hsc_env mod_name err)) + let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags + err_txt = formatBulleted $ missingInterfaceErrorDiagnostic tries + $ cannotFindModule hsc_env mod_name err in throwCmdLineErrorS dflags err_txt where doc = text "contains a name used in an invocation of lookupRdrNameInModule" ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -21,9 +21,13 @@ module GHC.Tc.Errors.Ppr , inHsDocContext , TcRnMessageOpts(..) + , interfaceErrorHints + , interfaceErrorReason + , interfaceErrorDiagnostic , missingInterfaceErrorHints , missingInterfaceErrorReason , missingInterfaceErrorDiagnostic + , readInterfaceErrorDiagnostic ) where @@ -1411,9 +1415,10 @@ instance Diagnostic TcRnMessage where hsep [ text "Unknown type variable" <> plural errorVars , text "on the RHS of injectivity condition:" , interpp'SP errorVars ] - - TcRnMissingInterfaceError reason - -> missingInterfaceErrorDiagnostic (tcOptsShowTriedFiles opts) reason + TcRnCan'tFindLocalName name + -> mkSimpleDecorated $ text "Can't find local name: " <+> ppr name + TcRnInterfaceError reason + -> interfaceErrorDiagnostic (tcOptsShowTriedFiles opts) reason diagnosticReason = \case @@ -1877,22 +1882,10 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnUnknownTyVarsOnRhsOfInjCond{} -> ErrorWithoutFlag - TcRnMissingInterfaceError reason - -> case reason of - BadSourceImport {} -> ErrorWithoutFlag - MissingDeclInInterface {} -> ErrorWithoutFlag - HomeModError {} -> ErrorWithoutFlag - DynamicHashMismatchError {} -> ErrorWithoutFlag - CantFindErr {} -> ErrorWithoutFlag - CantFindInstalledErr {} -> ErrorWithoutFlag - HiModuleNameMismatchWarn {} -> ErrorWithoutFlag - BadIfaceFile {} -> ErrorWithoutFlag - FailedToLoadDynamicInterface {} -> ErrorWithoutFlag - GenericException {} -> ErrorWithoutFlag - CantFindLocalName {} -> ErrorWithoutFlag - CantFindHiInterfaceForSig {} -> ErrorWithoutFlag - CantFindHiBoot {} -> ErrorWithoutFlag - InterfaceLookupError {} -> ErrorWithoutFlag + TcRnCan'tFindLocalName {} + -> ErrorWithoutFlag + TcRnInterfaceError err + -> interfaceErrorReason err diagnosticHints = \case @@ -2374,8 +2367,10 @@ instance Diagnostic TcRnMessage where -> noHints TcRnUnknownTyVarsOnRhsOfInjCond{} -> noHints - TcRnMissingInterfaceError reason - -> missingInterfaceErrorHints reason + TcRnCan'tFindLocalName {} + -> noHints + TcRnInterfaceError reason + -> interfaceErrorHints reason diagnosticCode = constructorCode @@ -2390,32 +2385,62 @@ commafyWith conjunction xs = addConjunction $ punctuate comma xs addConjunction (x : xs) = x : addConjunction xs addConjunction _ = panic "commafyWith expected 2 or more elements" +interfaceErrorHints :: InterfaceError -> [GhcHint] +interfaceErrorHints = \ case + Can'tFindInterface err _looking_for -> + missingInterfaceErrorHints err + Can'tFindNameInInterface {} -> + noHints + missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint] -missingInterfaceErrorHints reason = - case reason of - BadSourceImport {} -> noHints - MissingDeclInInterface {} -> noHints - HomeModError {} -> noHints - DynamicHashMismatchError {} -> noHints - CantFindErr {} -> noHints - CantFindInstalledErr {} -> noHints - HiModuleNameMismatchWarn {} -> noHints - BadIfaceFile {} -> noHints - FailedToLoadDynamicInterface {} -> noHints - GenericException {} -> noHints - CantFindLocalName {} -> noHints - CantFindHiInterfaceForSig {} -> noHints - CantFindHiBoot {} -> noHints - InterfaceLookupError {} -> noHints +missingInterfaceErrorHints = \case + BadSourceImport {} -> + noHints + HomeModError {} -> + noHints + DynamicHashMismatchError {} -> + noHints + CantFindErr {} -> + noHints + CantFindInstalledErr {} -> + noHints + BadIfaceFile {} -> + noHints + FailedToLoadDynamicInterface {} -> + noHints + CantFindLocalName {} -> + noHints + +interfaceErrorReason :: InterfaceError -> DiagnosticReason +interfaceErrorReason (Can'tFindInterface err _) + = missingInterfaceErrorReason err +interfaceErrorReason (Can'tFindNameInInterface {}) + = ErrorWithoutFlag missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason -missingInterfaceErrorReason _reason = ErrorWithoutFlag +missingInterfaceErrorReason = \ case + BadSourceImport {} -> + ErrorWithoutFlag + HomeModError {} -> + ErrorWithoutFlag + DynamicHashMismatchError {} -> + ErrorWithoutFlag + CantFindErr {} -> + ErrorWithoutFlag + CantFindInstalledErr {} -> + ErrorWithoutFlag + BadIfaceFile {} -> + ErrorWithoutFlag + FailedToLoadDynamicInterface {} -> + ErrorWithoutFlag + CantFindLocalName {} -> + ErrorWithoutFlag prettyCantFindWhat :: CantFindWhat -> SDoc prettyCantFindWhat CantFindModule = text "Could not find module" prettyCantFindWhat CantLoadModule = text "Could not load module" prettyCantFindWhat CantLoadInterface = text "Failed to load interface for" -prettyCantFindWhat AmbigiousModule = text "Ambiguous module name" +prettyCantFindWhat AmbiguousModule = text "Ambiguous module name" prettyCantFindWhat AmbiguousInterface = text "Ambigious interface for" cantFindError :: Bool -> CantFindInstalled -> DecoratedSDoc @@ -2493,11 +2518,18 @@ cantFindError verbose (CantFindInstalled mod_name what cfir) = in mkSimpleDecorated $ pp_suggestions ms $$ mayShowLocations verbose fps NotAModule -> mkSimpleDecorated $ text "It is not a module in the current program, or in any known package." CouldntFindInFiles fps -> mkSimpleDecorated (vcat (map text fps)) - MultiplePackages pkgs -> mkSimpleDecorated $ - sep [text "it was found in multiple packages:", - hsep (map ppr pkgs)] - MultiplePackages2 mods -> mkSimpleDecorated $ - vcat (map pprMod mods) + MultiplePackages mods + | Just pkgs <- unambiguousPackages + -> mkSimpleDecorated $ + sep [text "it was found in multiple packages:", + hsep (map ppr pkgs)] + | otherwise + -> mkSimpleDecorated $ vcat (map pprMod mods) + where + unambiguousPackages = foldl' unambiguousPackage (Just []) mods + unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) + = Just (moduleUnit m : xs) + unambiguousPackage _ _ = Nothing GenericMissing using_cabal pkg_hiddens mod_hiddens unusables files -> mkSimpleDecorated $ vcat (map (pkg_hidden using_cabal) pkg_hiddens) $$ vcat (map mod_hidden mod_hiddens) $$ @@ -2554,34 +2586,64 @@ mayShowLocations verbose files | otherwise = hang (text "Locations searched:") 2 $ vcat (map text files) +interfaceErrorDiagnostic :: Bool -> InterfaceError -> DecoratedSDoc +interfaceErrorDiagnostic verbose_files = \ case + Can'tFindInterface err looking_for -> + case looking_for of + LookingForName name -> + mkSimpleDecorated $ missingDeclInInterface name [] + LookingForModule mod is_boot -> + mkSimpleDecorated + (text "Could not find" <+> what <+> text "for" <+> quotes (ppr mod)) + `unionDecoratedSDoc` + (missingInterfaceErrorDiagnostic verbose_files err) + where + what + | IsBoot <- is_boot + = text "boot interface" + | otherwise + = text "interface" + LookingForHiBoot mod -> + mkSimpleDecorated + (text "Could not find hi-boot interface for" <+> quotes (ppr mod)) + `unionDecoratedSDoc` + (missingInterfaceErrorDiagnostic verbose_files err) + LookingForSig sig -> + mkSimpleDecorated + (text "Could not find interface file for signature" <+> quotes (ppr sig)) + `unionDecoratedSDoc` + (missingInterfaceErrorDiagnostic verbose_files err) + + Can'tFindNameInInterface name relevant_tyThings -> + mkSimpleDecorated $ missingDeclInInterface name relevant_tyThings + +readInterfaceErrorDiagnostic :: ReadInterfaceError -> DecoratedSDoc +readInterfaceErrorDiagnostic = \ case + ExceptionOccurred fp ex -> + mkSimpleDecorated $ + hang (text "Exception when reading interface file " <+> text fp) + 2 (text (showException ex)) + HiModuleNameMismatchWarn _ m1 m2 -> + mkSimpleDecorated $ hiModuleNameMismatchWarn m1 m2 + missingInterfaceErrorDiagnostic :: Bool -> MissingInterfaceError -> DecoratedSDoc missingInterfaceErrorDiagnostic verbose_files reason = case reason of BadSourceImport m -> mkSimpleDecorated $ badSourceImport m - MissingDeclInInterface name things -> mkSimpleDecorated $ missingDeclInInterface name things + --MissingDeclInInterface name things -> mkSimpleDecorated $ missingDeclInInterface name things HomeModError im ml -> mkSimpleDecorated $ homeModError im ml DynamicHashMismatchError m ml -> mkSimpleDecorated $ dynamicHashMismatchError m ml CantFindErr us cfi -> mkDecorated . map (pprWithUnitState us) . unDecorated $ cantFindError verbose_files cfi CantFindInstalledErr cfi -> cantFindError verbose_files cfi - HiModuleNameMismatchWarn m1 m2 -> mkSimpleDecorated $ hiModuleNameMismatchWarn m1 m2 - BadIfaceFile fp mie -> - -- TODO - mkSimpleDecorated (text fp) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie + BadIfaceFile rie -> readInterfaceErrorDiagnostic rie FailedToLoadDynamicInterface wanted_mod err -> mkSimpleDecorated (text "Failed to load dynamic interface file for" <+> ppr wanted_mod) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files err - GenericException se -> --- mkSimpleDecorated $ text "Exception when reading interface file for" <+> ppr mod - mkSimpleDecorated $ text (showException se) + `unionDecoratedSDoc` + readInterfaceErrorDiagnostic err CantFindLocalName name -> mkSimpleDecorated (text "Can't find local name: " <+> ppr name) - CantFindHiInterfaceForSig isig_mod mie -> - mkSimpleDecorated (text "Could not find hi interface for signature" <+> quotes (ppr isig_mod)) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie - CantFindHiBoot m mie -> - mkSimpleDecorated (text "Could not find hi-boot interface for" <+> quotes (ppr m)) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie - InterfaceLookupError _ mie -> missingInterfaceErrorDiagnostic verbose_files mie + --CantFindHiBoot m mie -> + -- mkSimpleDecorated (text "Could not find hi-boot interface for" <+> quotes (ppr m)) + -- `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie hiModuleNameMismatchWarn :: Module -> Module -> SDoc hiModuleNameMismatchWarn requested_mod read_mod @@ -2626,9 +2688,9 @@ missingDeclInInterface :: Name -> [TyThing] -> SDoc missingDeclInInterface name things = whenPprDebug (found_things $$ empty) $$ hang (text "Can't find interface-file declaration for" <+> - pprNameSpace (nameNameSpace name) <+> ppr name) - 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", - text "Use -ddump-if-trace to get an idea of which file caused the error"]) + pprNameSpace (nameNameSpace name) <+> ppr name) + 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", + text "Use -ddump-if-trace to get an idea of which file caused the error"]) where found_things = hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon) ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -49,6 +49,10 @@ module GHC.Tc.Errors.Types ( , FixedRuntimeRepErrorInfo(..) , MissingInterfaceError(..) + , InterfaceLookingFor(..) + , InterfaceError(..) + , ReadInterfaceError(..) + , ModDesc(..) , CantFindInstalled(..) , CantFindInstalledReason(..) , CantFindWhat(..) @@ -112,12 +116,14 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , FixedRuntimeRepOrigin(..) ) import GHC.Tc.Types.Rank (Rank) import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType) +import GHC.Types.Basic import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) import GHC.Types.ForeignCall (CLabelString) import GHC.Types.Name (Name, OccName, getSrcLoc, getSrcSpan) import qualified GHC.Types.Name.Occurrence as OccName import GHC.Types.Name.Reader +import GHC.Types.PkgQual import GHC.Types.SrcLoc import GHC.Types.TyThing (TyThing) import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar) @@ -137,7 +143,6 @@ import GHC.Core.TyCon (TyCon, TyConFlavour) import GHC.Core.Type (Kind, Type, ThetaType, PredType) import GHC.Driver.Backend (Backend) import GHC.Unit.State (UnitState, ModuleSuggestion, ModuleOrigin, UnusableUnitReason, UnitInfo) -import GHC.Types.Basic import GHC.Utils.Misc (capitalise, filterOut) import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString (FastString) @@ -3178,7 +3183,9 @@ data TcRnMessage where -} TcRnUnknownTyVarsOnRhsOfInjCond :: [Name] -> TcRnMessage - TcRnMissingInterfaceError :: !MissingInterfaceError -> TcRnMessage + TcRnCan'tFindLocalName :: !Name -> TcRnMessage + + TcRnInterfaceError :: !InterfaceError -> TcRnMessage deriving Generic @@ -3598,41 +3605,63 @@ instance Outputable Exported where ppr IsNotExported = text "IsNotExported" ppr IsExported = text "IsExported" -data MissingInterfaceError = - BadSourceImport !Module - | MissingDeclInInterface !Name [TyThing] - | HomeModError !InstalledModule !ModLocation - | DynamicHashMismatchError !Module !ModLocation - | HiModuleNameMismatchWarn Module Module - | CantFindLocalName Name - -- dodgy? - | GenericException SomeException - -- Can't find errors - | CantFindErr !UnitState CantFindInstalled - | CantFindInstalledErr CantFindInstalled - -- Adding context - | BadIfaceFile FilePath MissingInterfaceError - | FailedToLoadDynamicInterface Module MissingInterfaceError - | CantFindHiInterfaceForSig InstalledModule MissingInterfaceError - | CantFindHiBoot Module MissingInterfaceError - | InterfaceLookupError Name MissingInterfaceError - deriving Generic - -data CantFindInstalledReason = NoUnitIdMatching UnitId [UnitInfo] - | MissingPackageFiles UnitId [FilePath] - | MissingPackageWayFiles String UnitId [FilePath] - | ModuleSuggestion [ModuleSuggestion] [FilePath] - | NotAModule - | CouldntFindInFiles [FilePath] - | GenericMissing BuildingCabalPackage [(Unit, Maybe UnitInfo)] [Unit] [(Unit, UnusableUnitReason)] [FilePath] - -- Ambiguous - | MultiplePackages [Unit] - | MultiplePackages2 [(Module, ModuleOrigin)] - deriving Generic - -data CantFindInstalled = CantFindInstalled ModuleName CantFindWhat CantFindInstalledReason deriving Generic - -data CantFindWhat = CantFindModule | CantLoadModule | CantLoadInterface | AmbiguousInterface | AmbigiousModule +data InterfaceLookingFor + = LookingForName !Name + | LookingForHiBoot !Module + | LookingForModule !ModuleName !IsBootInterface + | LookingForSig !InstalledModule + +data ModDesc + = NamedModule !ModuleName !PkgQual + | ActualModule !Module + +data InterfaceError + = Can'tFindInterface + MissingInterfaceError + InterfaceLookingFor + | Can'tFindNameInInterface + Name + [TyThing] -- possibly relevant TyThings + deriving Generic + +data MissingInterfaceError + = BadSourceImport !Module + | HomeModError !InstalledModule !ModLocation + | DynamicHashMismatchError !Module !ModLocation + | CantFindLocalName Name + -- dodgy? + -- Can't find errors + | CantFindErr !UnitState CantFindInstalled + | CantFindInstalledErr CantFindInstalled + -- Adding context + | BadIfaceFile ReadInterfaceError + | FailedToLoadDynamicInterface Module ReadInterfaceError + deriving Generic + +data ReadInterfaceError + = ExceptionOccurred FilePath SomeException + | HiModuleNameMismatchWarn FilePath Module Module + deriving Generic + +data CantFindInstalledReason + = NoUnitIdMatching UnitId [UnitInfo] + | MissingPackageFiles UnitId [FilePath] + | MissingPackageWayFiles String UnitId [FilePath] + | ModuleSuggestion [ModuleSuggestion] [FilePath] + | NotAModule + | CouldntFindInFiles [FilePath] + | GenericMissing BuildingCabalPackage [(Unit, Maybe UnitInfo)] [Unit] [(Unit, UnusableUnitReason)] [FilePath] + | MultiplePackages [(Module, ModuleOrigin)] + deriving Generic + +data CantFindInstalled = + CantFindInstalled ModuleName CantFindWhat CantFindInstalledReason + deriving Generic + +data CantFindWhat + = CantFindModule | CantLoadModule | CantLoadInterface + | AmbiguousInterface | AmbiguousModule + -------------------------------------------------------------------------------- -- -- Errors used in GHC.Tc.Errors ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2024,7 +2024,7 @@ tcLookupTh name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return (AGlobal thing) - Failed msg -> failWithTc (TcRnMissingInterfaceError (InterfaceLookupError name msg)) + Failed msg -> failWithTc (TcRnInterfaceError msg) }}}} notInScope :: TH.Name -> TcRnMessage ===================================== compiler/GHC/Tc/Utils/Backpack.hs ===================================== @@ -168,7 +168,7 @@ checkHsigIface tcg_env gr sig_iface -- tcg_env (TODO: but maybe this isn't relevant anymore). r <- tcLookupImported_maybe name case r of - Failed err -> addErr (TcRnMissingInterfaceError (InterfaceLookupError name err)) + Failed err -> addErr (TcRnInterfaceError err) Succeeded real_thing -> checkHsigDeclM sig_iface sig_thing real_thing -- The hsig did NOT define this function; that means it must @@ -564,8 +564,7 @@ mergeSignatures ctx = initSDocContext dflags defaultUserStyle fmap fst . withIfaceErr ctx - $ findAndReadIface hsc_env - (text "mergeSignatures") im m NotBoot + $ findAndReadIface hsc_env (text "mergeSignatures") im m NotBoot -- STEP 3: Get the unrenamed exports of all these interfaces, -- thin it according to the export list, and do shaping on them. @@ -996,11 +995,9 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do isig_mod sig_mod NotBoot isig_iface <- case mb_isig_iface of Succeeded (iface, _) -> return iface - Failed err -> failWithTc $ TcRnMissingInterfaceError $ CantFindHiInterfaceForSig isig_mod err - {- - hang (text "Could not find hi interface for signature" <+> - quotes (ppr isig_mod) <> colon) 4 err - -} + Failed err -> + failWithTc $ TcRnInterfaceError $ + Can'tFindInterface err (LookingForSig isig_mod) -- STEP 3: Check that the implementing interface exports everything -- we need. (Notice we IGNORE the Modules in the AvailInfos.) ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -153,12 +153,13 @@ lookupGlobal hsc_env name mb_thing <- lookupGlobal_maybe hsc_env name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts (hsc_dflags hsc_env)) (TcRnMissingInterfaceError msg) + Failed err -> + let err_txt = formatBulleted + $ diagnosticMessage (initTcMessageOpts (hsc_dflags hsc_env)) + err in pprPanic "lookupGlobal" err_txt } - -lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) +lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr TcRnMessage TyThing) -- This may look up an Id that one has previously looked up. -- If so, we are going to read its interface file, and add its bindings -- to the ExternalPackageTable. @@ -169,24 +170,26 @@ lookupGlobal_maybe hsc_env name tcg_semantic_mod = homeModuleInstantiation mhome_unit mod ; if nameIsLocalOrFrom tcg_semantic_mod name - then (return - (Failed (CantFindLocalName name))) - -- Internal names can happen in GHCi - else - -- Try home package table and external package table - lookupImported_maybe hsc_env name + then return $ Failed $ TcRnCan'tFindLocalName name + -- Internal names can happen in GHCi + else do + res <- lookupImported_maybe hsc_env name + -- Try home package table and external package table + return $ case res of + Succeeded ok -> Succeeded ok + Failed err -> Failed (TcRnInterfaceError err) } -lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) +lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr InterfaceError TyThing) -- Returns (Failed err) if we can't find the interface file for the thing lookupImported_maybe hsc_env name = do { mb_thing <- lookupType hsc_env name ; case mb_thing of Just thing -> return (Succeeded thing) Nothing -> importDecl_maybe hsc_env name - } + } -importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) +importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr InterfaceError TyThing) importDecl_maybe hsc_env name | Just thing <- wiredInNameTyThing_maybe name = do { when (needWiredInHomeIface thing) @@ -245,7 +248,7 @@ tcLookupGlobal name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> failWithTc (TcRnMissingInterfaceError (InterfaceLookupError name msg)) + Failed msg -> failWithTc (TcRnInterfaceError msg) }}} -- Look up only in this module's global env't. Don't look in imports, etc. ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -217,6 +218,7 @@ import Data.IORef import Control.Monad import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Ppr import {-# SOURCE #-} GHC.Tc.Utils.Env ( tcInitTidyEnv ) import qualified Data.Map as Map @@ -668,8 +670,8 @@ withIfaceErr ctx do_this = do r <- do_this case r of Failed err -> do - let diag = TcRnMissingInterfaceError err - msg = pprDiagnostic diag + let tries = tcOptsShowTriedFiles $ defaultDiagnosticOpts @TcRnMessage + msg = formatBulleted $ missingInterfaceErrorDiagnostic tries err liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx msg)) Succeeded result -> return result ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -530,6 +530,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnShadowedTyVarNameInFamResult" = 99412 GhcDiagnosticCode "TcRnIncorrectTyVarOnLhsOfInjCond" = 88333 GhcDiagnosticCode "TcRnUnknownTyVarsOnRhsOfInjCond" = 48254 + GhcDiagnosticCode "TcRnCan'tFindLocalName" = 11111 -- SLD TODO -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 @@ -583,32 +584,28 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "OneArgExpected" = 91490 GhcDiagnosticCode "AtLeastOneArgExpected" = 07641 - -- Missing interface errors + -- Interface errors GhcDiagnosticCode "BadSourceImport" = 00001 - GhcDiagnosticCode "MissingDeclInInterface" = 00002 - GhcDiagnosticCode "MissingInterfaceError" = 00003 - GhcDiagnosticCode "HomeModError" = 00004 - GhcDiagnosticCode "DynamicHashMismatchError" = 00005 - GhcDiagnosticCode "BadIfaceFile" = 00006 - GhcDiagnosticCode "CantFindLocalName" = 00009 - GhcDiagnosticCode "FailedToLoadDynamicInterface" = 00010 - GhcDiagnosticCode "GenericException" = 00011 - GhcDiagnosticCode "HiModuleNameMismatch" = 00012 - GhcDiagnosticCode "HiModuleNameMismatchWarn" = 00013 - GhcDiagnosticCode "UsedAsDataConstructor" = 00014 - GhcDiagnosticCode "CantFindHiInterfaceForSig" = 00015 - - GhcDiagnosticCode "CouldntFindInFiles" = 00016 - GhcDiagnosticCode "GenericMissing" = 00017 - GhcDiagnosticCode "MissingPackageFiles" = 00018 - GhcDiagnosticCode "MissingPackageWayFiles" = 00019 - GhcDiagnosticCode "ModuleSuggestion" = 00020 - GhcDiagnosticCode "MultiplePackages" = 00021 - GhcDiagnosticCode "MultiplePackages2" = 00022 - GhcDiagnosticCode "NoUnitIdMatching" = 00023 - GhcDiagnosticCode "NotAModule" = 00024 - GhcDiagnosticCode "CantFindHiBoot" = 00025 - + GhcDiagnosticCode "MissingDeclInInterface" = 00002 + GhcDiagnosticCode "MissingInterfaceError" = 00003 + GhcDiagnosticCode "HomeModError" = 00004 + GhcDiagnosticCode "DynamicHashMismatchError" = 00005 + GhcDiagnosticCode "BadIfaceFile" = 00006 + GhcDiagnosticCode "CantFindLocalName" = 00009 + GhcDiagnosticCode "FailedToLoadDynamicInterface" = 00010 + GhcDiagnosticCode "UsedAsDataConstructor" = 00014 + GhcDiagnosticCode "CouldntFindInFiles" = 00016 + GhcDiagnosticCode "GenericMissing" = 00017 + GhcDiagnosticCode "MissingPackageFiles" = 00018 + GhcDiagnosticCode "MissingPackageWayFiles" = 00019 + GhcDiagnosticCode "ModuleSuggestion" = 00020 + GhcDiagnosticCode "MultiplePackages" = 00022 + GhcDiagnosticCode "NoUnitIdMatching" = 00023 + GhcDiagnosticCode "NotAModule" = 00024 + GhcDiagnosticCode "Can'tFindNameInInterface" = 00026 + + GhcDiagnosticCode "HiModuleNameMismatchWarn" = 00012 + GhcDiagnosticCode "ExceptionOccurred" = 00011 -- Out of scope errors GhcDiagnosticCode "NotInScope" = 76037 @@ -702,13 +699,10 @@ type family ConRecursInto con where ConRecursInto "CantFindErr" = 'Just CantFindInstalled ConRecursInto "CantFindInstalledErr" = 'Just CantFindInstalled - ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason + ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason - ConRecursInto "BadIfaceFile" = 'Just MissingInterfaceError - ConRecursInto "FailedToLoadDynamicInterface" = 'Just MissingInterfaceError - ConRecursInto "CantFindHiInterfaceForSig" = 'Just MissingInterfaceError - ConRecursInto "CantFindHiBoot" = 'Just MissingInterfaceError - ConRecursInto "InterfaceLookupError" = 'Just MissingInterfaceError + ConRecursInto "BadIfaceFile" = 'Just ReadInterfaceError + ConRecursInto "FailedToLoadDynamicInterface" = 'Just ReadInterfaceError ---------------------------------- -- Constructors of PsMessage @@ -737,7 +731,10 @@ type family ConRecursInto con where ConRecursInto "TcRnRunSpliceFailure" = 'Just RunSpliceFailReason ConRecursInto "ConversionFail" = 'Just ConversionFailReason - ConRecursInto "TcRnMissingInterfaceError" = 'Just MissingInterfaceError + -- Interface file errors + + ConRecursInto "TcRnInterfaceError" = 'Just InterfaceError + ConRecursInto "Can'tFindInterface" = 'Just MissingInterfaceError ------------------ -- FFI errors View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd9256235ec8c70f9248f4f2289559cde3255b27 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd9256235ec8c70f9248f4f2289559cde3255b27 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 15:44:49 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Wed, 15 Mar 2023 11:44:49 -0400 Subject: [Git][ghc/ghc][wip/interface-loading-errs] refactor interface error datatypes Message-ID: <6411e7f195ca6_37e76b21e5389831238d@gitlab.mail> sheaf pushed to branch wip/interface-loading-errs at Glasgow Haskell Compiler / GHC Commits: 86701671 by sheaf at 2023-03-15T16:44:32+01:00 refactor interface error datatypes - - - - - 16 changed files: - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Tidy.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error/Codes.hs Changes: ===================================== compiler/GHC/Driver/Config/Diagnostic.hs ===================================== @@ -49,8 +49,9 @@ initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage initPsMessageOpts _ = NoDiagnosticOpts initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage -initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags - , tcOptsShowTriedFiles = verbosity dflags >= 3 } +initTcMessageOpts dflags = + TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags + , tcOptsShowTriedFiles = verbosity dflags >= 3 } initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage initDsMessageOpts _ = NoDiagnosticOpts ===================================== compiler/GHC/Driver/Config/Tidy.hs ===================================== @@ -28,7 +28,6 @@ import GHC.Platform.Ways import qualified GHC.LanguageExtensions as LangExt import GHC.Types.Error import GHC.Utils.Error -import GHC.Tc.Errors.Types (TcRnMessage(..)) import GHC.Driver.Config.Diagnostic (initTcMessageOpts) initTidyOpts :: HscEnv -> IO TidyOpts @@ -56,11 +55,10 @@ initStaticPtrOpts hsc_env = do let lookupM n = lookupGlobal_maybe hsc_env n >>= \case Succeeded r -> pure r Failed err -> - let txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError err) + let txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) err in pprPanic "initStaticPtrOpts: couldn't find" (ppr (txt, n)) - mk_string <- getMkStringIds (fmap tyThingId . lookupM) static_ptr_info_datacon <- tyThingDataCon <$> lookupM staticPtrInfoDataConName static_ptr_datacon <- tyThingDataCon <$> lookupM staticPtrDataConName ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -16,7 +16,7 @@ import GHC.Driver.Flags import GHC.Driver.Session import GHC.HsToCore.Errors.Ppr () import GHC.Parser.Errors.Ppr () -import GHC.Tc.Errors.Ppr (missingInterfaceErrorHints, missingInterfaceErrorReason, missingInterfaceErrorDiagnostic) +import GHC.Tc.Errors.Ppr import GHC.Types.Error import GHC.Types.Error.Codes ( constructorCode ) import GHC.Unit.Types ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -16,28 +16,26 @@ import GHC.Driver.Env import GHC.Driver.Errors.Types import GHC.Data.Maybe import GHC.Prelude +import GHC.Tc.Errors.Types import GHC.Unit import GHC.Unit.Env import GHC.Unit.Finder.Types import GHC.Utils.Outputable as Outputable -import GHC.Tc.Errors.Types (MissingInterfaceError (..), CantFindInstalled(..), CantFindInstalledReason(..), CantFindWhat(..), BuildingCabalPackage) +-- ----------------------------------------------------------------------------- +-- Error messages badIfaceFile :: String -> SDoc -> SDoc badIfaceFile file err = vcat [text "Bad interface file:" <+> text file, nest 4 err] - - - --- ----------------------------------------------------------------------------- --- Error messages - -cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile -> ModuleName -> InstalledFindResult -> MissingInterfaceError -cannotFindInterface us mhu p mn ifr = CantFindInstalledErr (cantFindInstalledErr CantLoadInterface - AmbiguousInterface us mhu p mn ifr) - +cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile + -> ModuleName -> InstalledFindResult -> MissingInterfaceError +cannotFindInterface us mhu p mn ifr = + CantFindInstalledErr $ + cantFindInstalledErr CantLoadInterface + AmbiguousInterface us mhu p mn ifr cantFindInstalledErr :: CantFindWhat @@ -96,11 +94,13 @@ cannotFindModule hsc_env = cannotFindModule' (targetProfile (hsc_dflags hsc_env)) -cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> MissingInterfaceError -cannotFindModule' dflags unit_env profile mod res = CantFindErr (ue_units unit_env) $ +cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult + -> MissingInterfaceError +cannotFindModule' dflags unit_env profile mod res = + CantFindErr (ue_units unit_env) $ cantFindErr (checkBuildingCabalPackage dflags) cannotFindMsg - AmbigiousModule + AmbiguousModule unit_env profile mod @@ -125,15 +125,7 @@ cantFindErr -> FindResult -> CantFindInstalled cantFindErr _ _ multiple_found _ _ mod_name (FoundMultiple mods) - | Just pkgs <- unambiguousPackages - = CantFindInstalled mod_name multiple_found (MultiplePackages pkgs) - | otherwise - = CantFindInstalled mod_name multiple_found (MultiplePackages2 mods) - where - unambiguousPackages = foldl' unambiguousPackage (Just []) mods - unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) - = Just (moduleUnit m : xs) - unambiguousPackage _ _ = Nothing + = CantFindInstalled mod_name multiple_found (MultiplePackages mods) cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result = CantFindInstalled mod_name cannot_find more_info @@ -163,7 +155,9 @@ cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result -> NotAModule | otherwise - -> GenericMissing using_cabal (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) mod_hiddens unusables files + -> GenericMissing using_cabal + (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) + mod_hiddens unusables files _ -> panic "cantFindErr" build_tag = waysBuildTag (profileWays profile) @@ -177,4 +171,4 @@ cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result MissingPackageWayFiles build pkg files | otherwise - = MissingPackageFiles pkg files \ No newline at end of file + = MissingPackageFiles pkg files ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -143,7 +143,7 @@ where the code that e1 expands to might import some defns that also turn out to be needed by the code that e2 expands to. -} -tcLookupImported_maybe :: Name -> TcM (MaybeErr MissingInterfaceError TyThing) +tcLookupImported_maybe :: Name -> TcM (MaybeErr InterfaceError TyThing) -- Returns (Failed err) if we can't find the interface file for the thing tcLookupImported_maybe name = do { hsc_env <- getTopEnv @@ -152,7 +152,7 @@ tcLookupImported_maybe name Just thing -> return (Succeeded thing) Nothing -> tcImportDecl_maybe name } -tcImportDecl_maybe :: Name -> TcM (MaybeErr MissingInterfaceError TyThing) +tcImportDecl_maybe :: Name -> TcM (MaybeErr InterfaceError TyThing) -- Entry point for *source-code* uses of importDecl tcImportDecl_maybe name | Just thing <- wiredInNameTyThing_maybe name @@ -163,7 +163,7 @@ tcImportDecl_maybe name | otherwise = initIfaceTcRn (importDecl name) -importDecl :: Name -> IfM lcl (MaybeErr MissingInterfaceError TyThing) +importDecl :: Name -> IfM lcl (MaybeErr InterfaceError TyThing) -- Get the TyThing for this Name from an interface file -- It's not a wired-in thing -- the caller caught that importDecl name @@ -174,15 +174,18 @@ importDecl name -- Load the interface, which should populate the PTE ; mb_iface <- assertPpr (isExternalName name) (ppr name) $ loadInterface nd_doc (nameModule name) ImportBySystem - ; case mb_iface of { - Failed err_msg -> return (Failed err_msg) ; - Succeeded _ -> do + ; case mb_iface of + { Failed err_msg -> return $ Failed $ + Can'tFindInterface err_msg (LookingForName name) + ; Succeeded _ -> do -- Now look it up again; this time we should find it { eps <- getEps ; case lookupTypeEnv (eps_PTE eps) name of Just thing -> return $ Succeeded thing - Nothing -> return $ Failed (MissingDeclInInterface name (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps)) + Nothing -> return $ Failed $ + Can'tFindNameInInterface name + (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps) }}} where nd_doc = text "Need decl for" <+> ppr name @@ -289,8 +292,14 @@ loadSrcInterface :: SDoc loadSrcInterface doc mod want_boot maybe_pkg = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg ; case res of - Failed err -> failWithTc (TcRnMissingInterfaceError err) - Succeeded iface -> return iface } + Failed err -> + failWithTc $ + TcRnInterfaceError $ + Can'tFindInterface err $ + LookingForModule mod want_boot + Succeeded iface -> + return iface + } -- | Like 'loadSrcInterface', but returns a 'MaybeErr'. loadSrcInterface_maybe :: SDoc @@ -886,8 +895,8 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do _ -> do r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc) case r of - Failed _ - -> return r + Failed err + -> return (Failed $ BadIfaceFile err) Succeeded (iface,_fp) -> do r2 <- load_dynamic_too_maybe logger name_cache unit_state @@ -895,7 +904,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do iface loc case r2 of Failed sdoc -> return (Failed sdoc) - Succeeded {} -> return r + Succeeded {} -> return $ Succeeded (iface,_fp) err -> do trace_if logger (text "...not found") return $ Failed $ cannotFindInterface @@ -906,14 +915,18 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do err -- | Check if we need to try the dynamic interface for -dynamic-too -load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ()) +load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> ModIface -> ModLocation + -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc -- Indefinite interfaces are ALWAYS non-dynamic. | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ()) | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc | otherwise = return (Succeeded ()) -load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ()) +load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> ModIface -> ModLocation + -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case Succeeded (dynIface, _) @@ -929,7 +942,9 @@ load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do -read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr MissingInterfaceError (ModIface, FilePath)) +read_file :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> FilePath + -> IO (MaybeErr ReadInterfaceError (ModIface, FilePath)) read_file logger name_cache unit_state dflags wanted_mod file_path = do trace_if logger (text "readIFace" <+> text file_path) @@ -944,7 +959,7 @@ read_file logger name_cache unit_state dflags wanted_mod file_path = do (uninstantiateInstantiatedModule indef_mod) read_result <- readIface dflags name_cache wanted_mod' file_path case read_result of - Failed err -> return (Failed (BadIfaceFile file_path err)) + Failed err -> return (Failed err) Succeeded iface -> return (Succeeded (iface, file_path)) -- Don't forget to fill in the package name... @@ -965,7 +980,7 @@ readIface -> NameCache -> Module -> FilePath - -> IO (MaybeErr MissingInterfaceError ModIface) + -> IO (MaybeErr ReadInterfaceError ModIface) readIface dflags name_cache wanted_mod file_path = do let profile = targetProfile dflags res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path @@ -979,9 +994,9 @@ readIface dflags name_cache wanted_mod file_path = do | otherwise -> return (Failed err) where actual_mod = mi_module iface - err = HiModuleNameMismatchWarn wanted_mod actual_mod + err = HiModuleNameMismatchWarn file_path wanted_mod actual_mod - Left exn -> return (Failed (GenericException exn)) + Left exn -> return (Failed (ExceptionOccurred file_path exn)) {- ********************************************************* ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Iface.Recomp.Flags import GHC.Iface.Env import GHC.Core +import GHC.Tc.Errors.Ppr import GHC.Tc.Utils.Monad import GHC.Hs @@ -83,7 +84,6 @@ import GHC.List (uncons) import Data.Ord import Data.Containers.ListUtils import Data.Bifunctor -import GHC.Tc.Errors.Ppr (missingInterfaceErrorDiagnostic) {- ----------------------------------------------- @@ -293,8 +293,13 @@ check_old_iface hsc_env mod_summary maybe_iface read_result <- readIface read_dflags ncu (ms_mod mod_summary) iface_path case read_result of Failed err -> do - trace_if logger (text "FYI: cannot read old interface file:" $$ nest 4 (formatBulleted $ missingInterfaceErrorDiagnostic False err)) - trace_hi_diffs logger (text "Old interface file was invalid:" $$ nest 4 (formatBulleted $ missingInterfaceErrorDiagnostic False err)) + let blah = readInterfaceErrorDiagnostic err + trace_if logger + $ vcat [ text "FYI: cannot read old interface file:" + , nest 4 (formatBulleted blah) ] + trace_hi_diffs logger $ + vcat [ text "Old interface file was invalid:" + , nest 4 (formatBulleted blah) ] return Nothing Succeeded iface -> do trace_if logger (text "Read the interface file" <+> text iface_path) ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -50,6 +50,7 @@ import GHC.StgToCmm.Types import GHC.Runtime.Heap.Layout import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Ppr import GHC.Tc.TyCl.Build import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType @@ -130,7 +131,7 @@ import GHC.Unit.Module.WholeCoreBindings import Data.IORef import Data.Foldable import GHC.Builtin.Names (ioTyConName, rOOT_MAIN) -import GHC.Tc.Errors.Ppr (missingInterfaceErrorDiagnostic) + import GHC.Utils.Error {- @@ -576,13 +577,14 @@ tcHiBootIface hsc_src mod -- to check consistency against, rather than just when we notice -- that an hi-boot is necessary due to a circular import. { hsc_env <- getTopEnv - ; read_result <- liftIO $ findAndReadIface hsc_env - need (fst (getModuleInstantiation mod)) mod - IsBoot -- Hi-boot file + ; read_result <- liftIO $ findAndReadIface hsc_env need + (fst (getModuleInstantiation mod)) mod + IsBoot -- Hi-boot file ; case read_result of { - Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface - ; mkSelfBootInfo iface tc_iface } ; + Succeeded (iface, _path) -> + do { tc_iface <- initIfaceTcRn $ typecheckIface iface + ; mkSelfBootInfo iface tc_iface } ; Failed err -> -- There was no hi-boot file. But if there is circularity in @@ -598,7 +600,10 @@ tcHiBootIface hsc_src mod Nothing -> return NoSelfBoot -- error cases Just (GWIB { gwib_isBoot = is_boot }) -> case is_boot of - IsBoot -> failWithTc (TcRnMissingInterfaceError (CantFindHiBoot mod err)) + IsBoot -> + let diag = Can'tFindInterface err + (LookingForHiBoot mod) + in failWithTc (TcRnInterfaceError diag) -- The hi-boot file has mysteriously disappeared. NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop) -- Someone below us imported us! @@ -1961,7 +1966,7 @@ tcIfaceGlobal name { mb_thing <- importDecl name -- It's imported; go get it ; case mb_thing of - Failed err -> failIfM (ppr name <+> (formatBulleted $ missingInterfaceErrorDiagnostic False err)) + Failed err -> failIfM (ppr name <+> (formatBulleted $ interfaceErrorDiagnostic False err)) Succeeded thing -> return thing }}} ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -48,6 +48,7 @@ import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Finder import GHC.Tc.Utils.Monad +import GHC.Tc.Errors.Ppr import GHC.Runtime.Interpreter import GHCi.RemoteTypes @@ -120,7 +121,6 @@ import GHC.Iface.Load import GHC.Unit.Home import Data.Either import Control.Applicative -import GHC.Tc.Errors.Types (TcRnMessage(..)) uninitialised :: a uninitialised = panic "Loader not initialised" @@ -792,8 +792,9 @@ getLinkDeps hsc_env pls replace_osuf span mods mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $ loadInterface msg mod (ImportByUser NotBoot) iface <- case mb_iface of - Maybes.Failed err -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError err) + Maybes.Failed err -> + let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags + err_txt = formatBulleted $ missingInterfaceErrorDiagnostic tries err in throwGhcExceptionIO (ProgramError (showSDoc dflags err_txt)) Maybes.Succeeded iface -> return iface ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -44,6 +44,8 @@ import GHC.Core.Type ( Type, mkTyConTy ) import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( TyCon ) +import GHC.Tc.Errors.Ppr + import GHC.Types.SrcLoc ( noSrcSpan ) import GHC.Types.Name ( Name, nameModule_maybe ) import GHC.Types.Id ( idType ) @@ -52,11 +54,13 @@ import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS ) import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName , greMangledName, mkRdrQual ) +import GHC.Types.Unique.DFM import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) import GHC.Driver.Config.Finder ( initFinderOpts ) +import GHC.Driver.Config.Diagnostic ( initTcMessageOpts ) import GHC.Unit.Module ( Module, ModuleName ) -import GHC.Unit.Module.ModIface +import GHC.Unit.Module.ModIface ( ModIface_(mi_exports), ModIface ) import GHC.Unit.Env import GHC.Utils.Panic @@ -69,10 +73,8 @@ import Control.Monad ( unless ) import Data.Maybe ( mapMaybe ) import Unsafe.Coerce ( unsafeCoerce ) import GHC.Linker.Types -import GHC.Types.Unique.DFM import Data.List (unzip4) -import GHC.Tc.Errors.Types (TcRnMessage(..)) -import GHC.Driver.Config.Diagnostic (initTcMessageOpts) + -- | Loads the plugins specified in the pluginModNames field of the dynamic -- flags. Should be called after command line arguments are parsed, but before @@ -331,7 +333,9 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do Nothing -> throwCmdLineErrorS dflags $ hsep [text "Could not determine the exports of the module", ppr mod_name] err -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError (cannotFindModule hsc_env mod_name err)) + let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags + err_txt = formatBulleted $ missingInterfaceErrorDiagnostic tries + $ cannotFindModule hsc_env mod_name err in throwCmdLineErrorS dflags err_txt where doc = text "contains a name used in an invocation of lookupRdrNameInModule" ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -21,9 +21,13 @@ module GHC.Tc.Errors.Ppr , inHsDocContext , TcRnMessageOpts(..) + , interfaceErrorHints + , interfaceErrorReason + , interfaceErrorDiagnostic , missingInterfaceErrorHints , missingInterfaceErrorReason , missingInterfaceErrorDiagnostic + , readInterfaceErrorDiagnostic ) where @@ -1411,9 +1415,10 @@ instance Diagnostic TcRnMessage where hsep [ text "Unknown type variable" <> plural errorVars , text "on the RHS of injectivity condition:" , interpp'SP errorVars ] - - TcRnMissingInterfaceError reason - -> missingInterfaceErrorDiagnostic (tcOptsShowTriedFiles opts) reason + TcRnCan'tFindLocalName name + -> mkSimpleDecorated $ text "Can't find local name: " <+> ppr name + TcRnInterfaceError reason + -> interfaceErrorDiagnostic (tcOptsShowTriedFiles opts) reason diagnosticReason = \case @@ -1877,22 +1882,10 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnUnknownTyVarsOnRhsOfInjCond{} -> ErrorWithoutFlag - TcRnMissingInterfaceError reason - -> case reason of - BadSourceImport {} -> ErrorWithoutFlag - MissingDeclInInterface {} -> ErrorWithoutFlag - HomeModError {} -> ErrorWithoutFlag - DynamicHashMismatchError {} -> ErrorWithoutFlag - CantFindErr {} -> ErrorWithoutFlag - CantFindInstalledErr {} -> ErrorWithoutFlag - HiModuleNameMismatchWarn {} -> ErrorWithoutFlag - BadIfaceFile {} -> ErrorWithoutFlag - FailedToLoadDynamicInterface {} -> ErrorWithoutFlag - GenericException {} -> ErrorWithoutFlag - CantFindLocalName {} -> ErrorWithoutFlag - CantFindHiInterfaceForSig {} -> ErrorWithoutFlag - CantFindHiBoot {} -> ErrorWithoutFlag - InterfaceLookupError {} -> ErrorWithoutFlag + TcRnCan'tFindLocalName {} + -> ErrorWithoutFlag + TcRnInterfaceError err + -> interfaceErrorReason err diagnosticHints = \case @@ -2374,8 +2367,10 @@ instance Diagnostic TcRnMessage where -> noHints TcRnUnknownTyVarsOnRhsOfInjCond{} -> noHints - TcRnMissingInterfaceError reason - -> missingInterfaceErrorHints reason + TcRnCan'tFindLocalName {} + -> noHints + TcRnInterfaceError reason + -> interfaceErrorHints reason diagnosticCode = constructorCode @@ -2390,32 +2385,62 @@ commafyWith conjunction xs = addConjunction $ punctuate comma xs addConjunction (x : xs) = x : addConjunction xs addConjunction _ = panic "commafyWith expected 2 or more elements" +interfaceErrorHints :: InterfaceError -> [GhcHint] +interfaceErrorHints = \ case + Can'tFindInterface err _looking_for -> + missingInterfaceErrorHints err + Can'tFindNameInInterface {} -> + noHints + missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint] -missingInterfaceErrorHints reason = - case reason of - BadSourceImport {} -> noHints - MissingDeclInInterface {} -> noHints - HomeModError {} -> noHints - DynamicHashMismatchError {} -> noHints - CantFindErr {} -> noHints - CantFindInstalledErr {} -> noHints - HiModuleNameMismatchWarn {} -> noHints - BadIfaceFile {} -> noHints - FailedToLoadDynamicInterface {} -> noHints - GenericException {} -> noHints - CantFindLocalName {} -> noHints - CantFindHiInterfaceForSig {} -> noHints - CantFindHiBoot {} -> noHints - InterfaceLookupError {} -> noHints +missingInterfaceErrorHints = \case + BadSourceImport {} -> + noHints + HomeModError {} -> + noHints + DynamicHashMismatchError {} -> + noHints + CantFindErr {} -> + noHints + CantFindInstalledErr {} -> + noHints + BadIfaceFile {} -> + noHints + FailedToLoadDynamicInterface {} -> + noHints + CantFindLocalName {} -> + noHints + +interfaceErrorReason :: InterfaceError -> DiagnosticReason +interfaceErrorReason (Can'tFindInterface err _) + = missingInterfaceErrorReason err +interfaceErrorReason (Can'tFindNameInInterface {}) + = ErrorWithoutFlag missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason -missingInterfaceErrorReason _reason = ErrorWithoutFlag +missingInterfaceErrorReason = \ case + BadSourceImport {} -> + ErrorWithoutFlag + HomeModError {} -> + ErrorWithoutFlag + DynamicHashMismatchError {} -> + ErrorWithoutFlag + CantFindErr {} -> + ErrorWithoutFlag + CantFindInstalledErr {} -> + ErrorWithoutFlag + BadIfaceFile {} -> + ErrorWithoutFlag + FailedToLoadDynamicInterface {} -> + ErrorWithoutFlag + CantFindLocalName {} -> + ErrorWithoutFlag prettyCantFindWhat :: CantFindWhat -> SDoc prettyCantFindWhat CantFindModule = text "Could not find module" prettyCantFindWhat CantLoadModule = text "Could not load module" prettyCantFindWhat CantLoadInterface = text "Failed to load interface for" -prettyCantFindWhat AmbigiousModule = text "Ambiguous module name" +prettyCantFindWhat AmbiguousModule = text "Ambiguous module name" prettyCantFindWhat AmbiguousInterface = text "Ambigious interface for" cantFindError :: Bool -> CantFindInstalled -> DecoratedSDoc @@ -2493,11 +2518,18 @@ cantFindError verbose (CantFindInstalled mod_name what cfir) = in mkSimpleDecorated $ pp_suggestions ms $$ mayShowLocations verbose fps NotAModule -> mkSimpleDecorated $ text "It is not a module in the current program, or in any known package." CouldntFindInFiles fps -> mkSimpleDecorated (vcat (map text fps)) - MultiplePackages pkgs -> mkSimpleDecorated $ - sep [text "it was found in multiple packages:", - hsep (map ppr pkgs)] - MultiplePackages2 mods -> mkSimpleDecorated $ - vcat (map pprMod mods) + MultiplePackages mods + | Just pkgs <- unambiguousPackages + -> mkSimpleDecorated $ + sep [text "it was found in multiple packages:", + hsep (map ppr pkgs)] + | otherwise + -> mkSimpleDecorated $ vcat (map pprMod mods) + where + unambiguousPackages = foldl' unambiguousPackage (Just []) mods + unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) + = Just (moduleUnit m : xs) + unambiguousPackage _ _ = Nothing GenericMissing using_cabal pkg_hiddens mod_hiddens unusables files -> mkSimpleDecorated $ vcat (map (pkg_hidden using_cabal) pkg_hiddens) $$ vcat (map mod_hidden mod_hiddens) $$ @@ -2554,34 +2586,64 @@ mayShowLocations verbose files | otherwise = hang (text "Locations searched:") 2 $ vcat (map text files) +interfaceErrorDiagnostic :: Bool -> InterfaceError -> DecoratedSDoc +interfaceErrorDiagnostic verbose_files = \ case + Can'tFindInterface err looking_for -> + case looking_for of + LookingForName name -> + mkSimpleDecorated $ missingDeclInInterface name [] + LookingForModule mod is_boot -> + mkSimpleDecorated + (text "Could not find" <+> what <+> text "for" <+> quotes (ppr mod)) + `unionDecoratedSDoc` + (missingInterfaceErrorDiagnostic verbose_files err) + where + what + | IsBoot <- is_boot + = text "boot interface" + | otherwise + = text "interface" + LookingForHiBoot mod -> + mkSimpleDecorated + (text "Could not find hi-boot interface for" <+> quotes (ppr mod)) + `unionDecoratedSDoc` + (missingInterfaceErrorDiagnostic verbose_files err) + LookingForSig sig -> + mkSimpleDecorated + (text "Could not find interface file for signature" <+> quotes (ppr sig)) + `unionDecoratedSDoc` + (missingInterfaceErrorDiagnostic verbose_files err) + + Can'tFindNameInInterface name relevant_tyThings -> + mkSimpleDecorated $ missingDeclInInterface name relevant_tyThings + +readInterfaceErrorDiagnostic :: ReadInterfaceError -> DecoratedSDoc +readInterfaceErrorDiagnostic = \ case + ExceptionOccurred fp ex -> + mkSimpleDecorated $ + hang (text "Exception when reading interface file " <+> text fp) + 2 (text (showException ex)) + HiModuleNameMismatchWarn _ m1 m2 -> + mkSimpleDecorated $ hiModuleNameMismatchWarn m1 m2 + missingInterfaceErrorDiagnostic :: Bool -> MissingInterfaceError -> DecoratedSDoc missingInterfaceErrorDiagnostic verbose_files reason = case reason of BadSourceImport m -> mkSimpleDecorated $ badSourceImport m - MissingDeclInInterface name things -> mkSimpleDecorated $ missingDeclInInterface name things + --MissingDeclInInterface name things -> mkSimpleDecorated $ missingDeclInInterface name things HomeModError im ml -> mkSimpleDecorated $ homeModError im ml DynamicHashMismatchError m ml -> mkSimpleDecorated $ dynamicHashMismatchError m ml CantFindErr us cfi -> mkDecorated . map (pprWithUnitState us) . unDecorated $ cantFindError verbose_files cfi CantFindInstalledErr cfi -> cantFindError verbose_files cfi - HiModuleNameMismatchWarn m1 m2 -> mkSimpleDecorated $ hiModuleNameMismatchWarn m1 m2 - BadIfaceFile fp mie -> - -- TODO - mkSimpleDecorated (text fp) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie + BadIfaceFile rie -> readInterfaceErrorDiagnostic rie FailedToLoadDynamicInterface wanted_mod err -> mkSimpleDecorated (text "Failed to load dynamic interface file for" <+> ppr wanted_mod) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files err - GenericException se -> --- mkSimpleDecorated $ text "Exception when reading interface file for" <+> ppr mod - mkSimpleDecorated $ text (showException se) + `unionDecoratedSDoc` + readInterfaceErrorDiagnostic err CantFindLocalName name -> mkSimpleDecorated (text "Can't find local name: " <+> ppr name) - CantFindHiInterfaceForSig isig_mod mie -> - mkSimpleDecorated (text "Could not find hi interface for signature" <+> quotes (ppr isig_mod)) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie - CantFindHiBoot m mie -> - mkSimpleDecorated (text "Could not find hi-boot interface for" <+> quotes (ppr m)) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie - InterfaceLookupError _ mie -> missingInterfaceErrorDiagnostic verbose_files mie + --CantFindHiBoot m mie -> + -- mkSimpleDecorated (text "Could not find hi-boot interface for" <+> quotes (ppr m)) + -- `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie hiModuleNameMismatchWarn :: Module -> Module -> SDoc hiModuleNameMismatchWarn requested_mod read_mod @@ -2626,9 +2688,9 @@ missingDeclInInterface :: Name -> [TyThing] -> SDoc missingDeclInInterface name things = whenPprDebug (found_things $$ empty) $$ hang (text "Can't find interface-file declaration for" <+> - pprNameSpace (nameNameSpace name) <+> ppr name) - 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", - text "Use -ddump-if-trace to get an idea of which file caused the error"]) + pprNameSpace (nameNameSpace name) <+> ppr name) + 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", + text "Use -ddump-if-trace to get an idea of which file caused the error"]) where found_things = hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon) ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -49,6 +49,9 @@ module GHC.Tc.Errors.Types ( , FixedRuntimeRepErrorInfo(..) , MissingInterfaceError(..) + , InterfaceLookingFor(..) + , InterfaceError(..) + , ReadInterfaceError(..) , CantFindInstalled(..) , CantFindInstalledReason(..) , CantFindWhat(..) @@ -112,6 +115,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , FixedRuntimeRepOrigin(..) ) import GHC.Tc.Types.Rank (Rank) import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType) +import GHC.Types.Basic import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) import GHC.Types.ForeignCall (CLabelString) @@ -137,7 +141,6 @@ import GHC.Core.TyCon (TyCon, TyConFlavour) import GHC.Core.Type (Kind, Type, ThetaType, PredType) import GHC.Driver.Backend (Backend) import GHC.Unit.State (UnitState, ModuleSuggestion, ModuleOrigin, UnusableUnitReason, UnitInfo) -import GHC.Types.Basic import GHC.Utils.Misc (capitalise, filterOut) import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString (FastString) @@ -3178,7 +3181,9 @@ data TcRnMessage where -} TcRnUnknownTyVarsOnRhsOfInjCond :: [Name] -> TcRnMessage - TcRnMissingInterfaceError :: !MissingInterfaceError -> TcRnMessage + TcRnCan'tFindLocalName :: !Name -> TcRnMessage + + TcRnInterfaceError :: !InterfaceError -> TcRnMessage deriving Generic @@ -3598,41 +3603,62 @@ instance Outputable Exported where ppr IsNotExported = text "IsNotExported" ppr IsExported = text "IsExported" -data MissingInterfaceError = - BadSourceImport !Module - | MissingDeclInInterface !Name [TyThing] - | HomeModError !InstalledModule !ModLocation - | DynamicHashMismatchError !Module !ModLocation - | HiModuleNameMismatchWarn Module Module - | CantFindLocalName Name - -- dodgy? - | GenericException SomeException - -- Can't find errors - | CantFindErr !UnitState CantFindInstalled - | CantFindInstalledErr CantFindInstalled - -- Adding context - | BadIfaceFile FilePath MissingInterfaceError - | FailedToLoadDynamicInterface Module MissingInterfaceError - | CantFindHiInterfaceForSig InstalledModule MissingInterfaceError - | CantFindHiBoot Module MissingInterfaceError - | InterfaceLookupError Name MissingInterfaceError - deriving Generic - -data CantFindInstalledReason = NoUnitIdMatching UnitId [UnitInfo] - | MissingPackageFiles UnitId [FilePath] - | MissingPackageWayFiles String UnitId [FilePath] - | ModuleSuggestion [ModuleSuggestion] [FilePath] - | NotAModule - | CouldntFindInFiles [FilePath] - | GenericMissing BuildingCabalPackage [(Unit, Maybe UnitInfo)] [Unit] [(Unit, UnusableUnitReason)] [FilePath] - -- Ambiguous - | MultiplePackages [Unit] - | MultiplePackages2 [(Module, ModuleOrigin)] - deriving Generic - -data CantFindInstalled = CantFindInstalled ModuleName CantFindWhat CantFindInstalledReason deriving Generic - -data CantFindWhat = CantFindModule | CantLoadModule | CantLoadInterface | AmbiguousInterface | AmbigiousModule +data InterfaceLookingFor + = LookingForName !Name + | LookingForHiBoot !Module + | LookingForModule !ModuleName !IsBootInterface + | LookingForSig !InstalledModule + +data InterfaceError + = Can'tFindInterface + MissingInterfaceError + InterfaceLookingFor + | Can'tFindNameInInterface + Name + [TyThing] -- possibly relevant TyThings + deriving Generic + +data MissingInterfaceError + = BadSourceImport !Module + | HomeModError !InstalledModule !ModLocation + | DynamicHashMismatchError !Module !ModLocation + | CantFindLocalName Name + + -- TODO: common up these two + | CantFindErr !UnitState CantFindInstalled + | CantFindInstalledErr CantFindInstalled + + | BadIfaceFile ReadInterfaceError + | FailedToLoadDynamicInterface Module ReadInterfaceError + deriving Generic + +data ReadInterfaceError + = ExceptionOccurred FilePath SomeException + | HiModuleNameMismatchWarn FilePath Module Module + deriving Generic + +data CantFindInstalledReason + = NoUnitIdMatching UnitId [UnitInfo] + | MissingPackageFiles UnitId [FilePath] + | MissingPackageWayFiles String UnitId [FilePath] + | ModuleSuggestion [ModuleSuggestion] [FilePath] + | NotAModule + | CouldntFindInFiles [FilePath] + | GenericMissing BuildingCabalPackage + [(Unit, Maybe UnitInfo)] [Unit] + [(Unit, UnusableUnitReason)] [FilePath] + | MultiplePackages [(Module, ModuleOrigin)] + deriving Generic + +data CantFindInstalled = + CantFindInstalled ModuleName CantFindWhat CantFindInstalledReason + deriving Generic + +data CantFindWhat + = CantFindModule | CantLoadModule | CantLoadInterface + | AmbiguousInterface | AmbiguousModule + -- TODO? + -------------------------------------------------------------------------------- -- -- Errors used in GHC.Tc.Errors ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2024,7 +2024,7 @@ tcLookupTh name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return (AGlobal thing) - Failed msg -> failWithTc (TcRnMissingInterfaceError (InterfaceLookupError name msg)) + Failed msg -> failWithTc (TcRnInterfaceError msg) }}}} notInScope :: TH.Name -> TcRnMessage ===================================== compiler/GHC/Tc/Utils/Backpack.hs ===================================== @@ -168,7 +168,7 @@ checkHsigIface tcg_env gr sig_iface -- tcg_env (TODO: but maybe this isn't relevant anymore). r <- tcLookupImported_maybe name case r of - Failed err -> addErr (TcRnMissingInterfaceError (InterfaceLookupError name err)) + Failed err -> addErr (TcRnInterfaceError err) Succeeded real_thing -> checkHsigDeclM sig_iface sig_thing real_thing -- The hsig did NOT define this function; that means it must @@ -564,8 +564,7 @@ mergeSignatures ctx = initSDocContext dflags defaultUserStyle fmap fst . withIfaceErr ctx - $ findAndReadIface hsc_env - (text "mergeSignatures") im m NotBoot + $ findAndReadIface hsc_env (text "mergeSignatures") im m NotBoot -- STEP 3: Get the unrenamed exports of all these interfaces, -- thin it according to the export list, and do shaping on them. @@ -996,11 +995,9 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do isig_mod sig_mod NotBoot isig_iface <- case mb_isig_iface of Succeeded (iface, _) -> return iface - Failed err -> failWithTc $ TcRnMissingInterfaceError $ CantFindHiInterfaceForSig isig_mod err - {- - hang (text "Could not find hi interface for signature" <+> - quotes (ppr isig_mod) <> colon) 4 err - -} + Failed err -> + failWithTc $ TcRnInterfaceError $ + Can'tFindInterface err (LookingForSig isig_mod) -- STEP 3: Check that the implementing interface exports everything -- we need. (Notice we IGNORE the Modules in the AvailInfos.) ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -153,12 +153,13 @@ lookupGlobal hsc_env name mb_thing <- lookupGlobal_maybe hsc_env name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts (hsc_dflags hsc_env)) (TcRnMissingInterfaceError msg) + Failed err -> + let err_txt = formatBulleted + $ diagnosticMessage (initTcMessageOpts (hsc_dflags hsc_env)) + err in pprPanic "lookupGlobal" err_txt } - -lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) +lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr TcRnMessage TyThing) -- This may look up an Id that one has previously looked up. -- If so, we are going to read its interface file, and add its bindings -- to the ExternalPackageTable. @@ -169,24 +170,26 @@ lookupGlobal_maybe hsc_env name tcg_semantic_mod = homeModuleInstantiation mhome_unit mod ; if nameIsLocalOrFrom tcg_semantic_mod name - then (return - (Failed (CantFindLocalName name))) - -- Internal names can happen in GHCi - else - -- Try home package table and external package table - lookupImported_maybe hsc_env name + then return $ Failed $ TcRnCan'tFindLocalName name + -- Internal names can happen in GHCi + else do + res <- lookupImported_maybe hsc_env name + -- Try home package table and external package table + return $ case res of + Succeeded ok -> Succeeded ok + Failed err -> Failed (TcRnInterfaceError err) } -lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) +lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr InterfaceError TyThing) -- Returns (Failed err) if we can't find the interface file for the thing lookupImported_maybe hsc_env name = do { mb_thing <- lookupType hsc_env name ; case mb_thing of Just thing -> return (Succeeded thing) Nothing -> importDecl_maybe hsc_env name - } + } -importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) +importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr InterfaceError TyThing) importDecl_maybe hsc_env name | Just thing <- wiredInNameTyThing_maybe name = do { when (needWiredInHomeIface thing) @@ -245,7 +248,7 @@ tcLookupGlobal name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> failWithTc (TcRnMissingInterfaceError (InterfaceLookupError name msg)) + Failed msg -> failWithTc (TcRnInterfaceError msg) }}} -- Look up only in this module's global env't. Don't look in imports, etc. ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -217,6 +218,7 @@ import Data.IORef import Control.Monad import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Ppr import {-# SOURCE #-} GHC.Tc.Utils.Env ( tcInitTidyEnv ) import qualified Data.Map as Map @@ -668,8 +670,8 @@ withIfaceErr ctx do_this = do r <- do_this case r of Failed err -> do - let diag = TcRnMissingInterfaceError err - msg = pprDiagnostic diag + let tries = tcOptsShowTriedFiles $ defaultDiagnosticOpts @TcRnMessage + msg = formatBulleted $ missingInterfaceErrorDiagnostic tries err liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx msg)) Succeeded result -> return result ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -530,6 +530,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnShadowedTyVarNameInFamResult" = 99412 GhcDiagnosticCode "TcRnIncorrectTyVarOnLhsOfInjCond" = 88333 GhcDiagnosticCode "TcRnUnknownTyVarsOnRhsOfInjCond" = 48254 + GhcDiagnosticCode "TcRnCan'tFindLocalName" = 11111 -- SLD TODO -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 @@ -583,32 +584,28 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "OneArgExpected" = 91490 GhcDiagnosticCode "AtLeastOneArgExpected" = 07641 - -- Missing interface errors + -- Interface errors GhcDiagnosticCode "BadSourceImport" = 00001 - GhcDiagnosticCode "MissingDeclInInterface" = 00002 - GhcDiagnosticCode "MissingInterfaceError" = 00003 - GhcDiagnosticCode "HomeModError" = 00004 - GhcDiagnosticCode "DynamicHashMismatchError" = 00005 - GhcDiagnosticCode "BadIfaceFile" = 00006 - GhcDiagnosticCode "CantFindLocalName" = 00009 - GhcDiagnosticCode "FailedToLoadDynamicInterface" = 00010 - GhcDiagnosticCode "GenericException" = 00011 - GhcDiagnosticCode "HiModuleNameMismatch" = 00012 - GhcDiagnosticCode "HiModuleNameMismatchWarn" = 00013 - GhcDiagnosticCode "UsedAsDataConstructor" = 00014 - GhcDiagnosticCode "CantFindHiInterfaceForSig" = 00015 - - GhcDiagnosticCode "CouldntFindInFiles" = 00016 - GhcDiagnosticCode "GenericMissing" = 00017 - GhcDiagnosticCode "MissingPackageFiles" = 00018 - GhcDiagnosticCode "MissingPackageWayFiles" = 00019 - GhcDiagnosticCode "ModuleSuggestion" = 00020 - GhcDiagnosticCode "MultiplePackages" = 00021 - GhcDiagnosticCode "MultiplePackages2" = 00022 - GhcDiagnosticCode "NoUnitIdMatching" = 00023 - GhcDiagnosticCode "NotAModule" = 00024 - GhcDiagnosticCode "CantFindHiBoot" = 00025 - + GhcDiagnosticCode "MissingDeclInInterface" = 00002 + GhcDiagnosticCode "MissingInterfaceError" = 00003 + GhcDiagnosticCode "HomeModError" = 00004 + GhcDiagnosticCode "DynamicHashMismatchError" = 00005 + GhcDiagnosticCode "BadIfaceFile" = 00006 + GhcDiagnosticCode "CantFindLocalName" = 00009 + GhcDiagnosticCode "FailedToLoadDynamicInterface" = 00010 + GhcDiagnosticCode "UsedAsDataConstructor" = 00014 + GhcDiagnosticCode "CouldntFindInFiles" = 00016 + GhcDiagnosticCode "GenericMissing" = 00017 + GhcDiagnosticCode "MissingPackageFiles" = 00018 + GhcDiagnosticCode "MissingPackageWayFiles" = 00019 + GhcDiagnosticCode "ModuleSuggestion" = 00020 + GhcDiagnosticCode "MultiplePackages" = 00022 + GhcDiagnosticCode "NoUnitIdMatching" = 00023 + GhcDiagnosticCode "NotAModule" = 00024 + GhcDiagnosticCode "Can'tFindNameInInterface" = 00026 + + GhcDiagnosticCode "HiModuleNameMismatchWarn" = 00012 + GhcDiagnosticCode "ExceptionOccurred" = 00011 -- Out of scope errors GhcDiagnosticCode "NotInScope" = 76037 @@ -702,13 +699,10 @@ type family ConRecursInto con where ConRecursInto "CantFindErr" = 'Just CantFindInstalled ConRecursInto "CantFindInstalledErr" = 'Just CantFindInstalled - ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason + ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason - ConRecursInto "BadIfaceFile" = 'Just MissingInterfaceError - ConRecursInto "FailedToLoadDynamicInterface" = 'Just MissingInterfaceError - ConRecursInto "CantFindHiInterfaceForSig" = 'Just MissingInterfaceError - ConRecursInto "CantFindHiBoot" = 'Just MissingInterfaceError - ConRecursInto "InterfaceLookupError" = 'Just MissingInterfaceError + ConRecursInto "BadIfaceFile" = 'Just ReadInterfaceError + ConRecursInto "FailedToLoadDynamicInterface" = 'Just ReadInterfaceError ---------------------------------- -- Constructors of PsMessage @@ -737,7 +731,10 @@ type family ConRecursInto con where ConRecursInto "TcRnRunSpliceFailure" = 'Just RunSpliceFailReason ConRecursInto "ConversionFail" = 'Just ConversionFailReason - ConRecursInto "TcRnMissingInterfaceError" = 'Just MissingInterfaceError + -- Interface file errors + + ConRecursInto "TcRnInterfaceError" = 'Just InterfaceError + ConRecursInto "Can'tFindInterface" = 'Just MissingInterfaceError ------------------ -- FFI errors View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/867016713fb84a7d0c9eb9a2bba92e8171bcf62c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/867016713fb84a7d0c9eb9a2bba92e8171bcf62c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 15:45:43 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Wed, 15 Mar 2023 11:45:43 -0400 Subject: [Git][ghc/ghc][wip/interface-loading-errs] refactor interface error datatypes Message-ID: <6411e827b1472_37e76b21e98498312525@gitlab.mail> sheaf pushed to branch wip/interface-loading-errs at Glasgow Haskell Compiler / GHC Commits: 253385ee by sheaf at 2023-03-15T16:45:27+01:00 refactor interface error datatypes - - - - - 16 changed files: - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Tidy.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error/Codes.hs Changes: ===================================== compiler/GHC/Driver/Config/Diagnostic.hs ===================================== @@ -49,8 +49,9 @@ initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage initPsMessageOpts _ = NoDiagnosticOpts initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage -initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags - , tcOptsShowTriedFiles = verbosity dflags >= 3 } +initTcMessageOpts dflags = + TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags + , tcOptsShowTriedFiles = verbosity dflags >= 3 } initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage initDsMessageOpts _ = NoDiagnosticOpts ===================================== compiler/GHC/Driver/Config/Tidy.hs ===================================== @@ -28,7 +28,6 @@ import GHC.Platform.Ways import qualified GHC.LanguageExtensions as LangExt import GHC.Types.Error import GHC.Utils.Error -import GHC.Tc.Errors.Types (TcRnMessage(..)) import GHC.Driver.Config.Diagnostic (initTcMessageOpts) initTidyOpts :: HscEnv -> IO TidyOpts @@ -56,11 +55,10 @@ initStaticPtrOpts hsc_env = do let lookupM n = lookupGlobal_maybe hsc_env n >>= \case Succeeded r -> pure r Failed err -> - let txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError err) + let txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) err in pprPanic "initStaticPtrOpts: couldn't find" (ppr (txt, n)) - mk_string <- getMkStringIds (fmap tyThingId . lookupM) static_ptr_info_datacon <- tyThingDataCon <$> lookupM staticPtrInfoDataConName static_ptr_datacon <- tyThingDataCon <$> lookupM staticPtrDataConName ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -16,7 +16,7 @@ import GHC.Driver.Flags import GHC.Driver.Session import GHC.HsToCore.Errors.Ppr () import GHC.Parser.Errors.Ppr () -import GHC.Tc.Errors.Ppr (missingInterfaceErrorHints, missingInterfaceErrorReason, missingInterfaceErrorDiagnostic) +import GHC.Tc.Errors.Ppr import GHC.Types.Error import GHC.Types.Error.Codes ( constructorCode ) import GHC.Unit.Types ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -16,28 +16,26 @@ import GHC.Driver.Env import GHC.Driver.Errors.Types import GHC.Data.Maybe import GHC.Prelude +import GHC.Tc.Errors.Types import GHC.Unit import GHC.Unit.Env import GHC.Unit.Finder.Types import GHC.Utils.Outputable as Outputable -import GHC.Tc.Errors.Types (MissingInterfaceError (..), CantFindInstalled(..), CantFindInstalledReason(..), CantFindWhat(..), BuildingCabalPackage) +-- ----------------------------------------------------------------------------- +-- Error messages badIfaceFile :: String -> SDoc -> SDoc badIfaceFile file err = vcat [text "Bad interface file:" <+> text file, nest 4 err] - - - --- ----------------------------------------------------------------------------- --- Error messages - -cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile -> ModuleName -> InstalledFindResult -> MissingInterfaceError -cannotFindInterface us mhu p mn ifr = CantFindInstalledErr (cantFindInstalledErr CantLoadInterface - AmbiguousInterface us mhu p mn ifr) - +cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile + -> ModuleName -> InstalledFindResult -> MissingInterfaceError +cannotFindInterface us mhu p mn ifr = + CantFindInstalledErr $ + cantFindInstalledErr CantLoadInterface + AmbiguousInterface us mhu p mn ifr cantFindInstalledErr :: CantFindWhat @@ -96,11 +94,13 @@ cannotFindModule hsc_env = cannotFindModule' (targetProfile (hsc_dflags hsc_env)) -cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> MissingInterfaceError -cannotFindModule' dflags unit_env profile mod res = CantFindErr (ue_units unit_env) $ +cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult + -> MissingInterfaceError +cannotFindModule' dflags unit_env profile mod res = + CantFindErr (ue_units unit_env) $ cantFindErr (checkBuildingCabalPackage dflags) cannotFindMsg - AmbigiousModule + AmbiguousModule unit_env profile mod @@ -125,15 +125,7 @@ cantFindErr -> FindResult -> CantFindInstalled cantFindErr _ _ multiple_found _ _ mod_name (FoundMultiple mods) - | Just pkgs <- unambiguousPackages - = CantFindInstalled mod_name multiple_found (MultiplePackages pkgs) - | otherwise - = CantFindInstalled mod_name multiple_found (MultiplePackages2 mods) - where - unambiguousPackages = foldl' unambiguousPackage (Just []) mods - unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) - = Just (moduleUnit m : xs) - unambiguousPackage _ _ = Nothing + = CantFindInstalled mod_name multiple_found (MultiplePackages mods) cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result = CantFindInstalled mod_name cannot_find more_info @@ -163,7 +155,9 @@ cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result -> NotAModule | otherwise - -> GenericMissing using_cabal (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) mod_hiddens unusables files + -> GenericMissing using_cabal + (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) + mod_hiddens unusables files _ -> panic "cantFindErr" build_tag = waysBuildTag (profileWays profile) @@ -177,4 +171,4 @@ cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result MissingPackageWayFiles build pkg files | otherwise - = MissingPackageFiles pkg files \ No newline at end of file + = MissingPackageFiles pkg files ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -143,7 +143,7 @@ where the code that e1 expands to might import some defns that also turn out to be needed by the code that e2 expands to. -} -tcLookupImported_maybe :: Name -> TcM (MaybeErr MissingInterfaceError TyThing) +tcLookupImported_maybe :: Name -> TcM (MaybeErr InterfaceError TyThing) -- Returns (Failed err) if we can't find the interface file for the thing tcLookupImported_maybe name = do { hsc_env <- getTopEnv @@ -152,7 +152,7 @@ tcLookupImported_maybe name Just thing -> return (Succeeded thing) Nothing -> tcImportDecl_maybe name } -tcImportDecl_maybe :: Name -> TcM (MaybeErr MissingInterfaceError TyThing) +tcImportDecl_maybe :: Name -> TcM (MaybeErr InterfaceError TyThing) -- Entry point for *source-code* uses of importDecl tcImportDecl_maybe name | Just thing <- wiredInNameTyThing_maybe name @@ -163,7 +163,7 @@ tcImportDecl_maybe name | otherwise = initIfaceTcRn (importDecl name) -importDecl :: Name -> IfM lcl (MaybeErr MissingInterfaceError TyThing) +importDecl :: Name -> IfM lcl (MaybeErr InterfaceError TyThing) -- Get the TyThing for this Name from an interface file -- It's not a wired-in thing -- the caller caught that importDecl name @@ -174,15 +174,18 @@ importDecl name -- Load the interface, which should populate the PTE ; mb_iface <- assertPpr (isExternalName name) (ppr name) $ loadInterface nd_doc (nameModule name) ImportBySystem - ; case mb_iface of { - Failed err_msg -> return (Failed err_msg) ; - Succeeded _ -> do + ; case mb_iface of + { Failed err_msg -> return $ Failed $ + Can'tFindInterface err_msg (LookingForName name) + ; Succeeded _ -> do -- Now look it up again; this time we should find it { eps <- getEps ; case lookupTypeEnv (eps_PTE eps) name of Just thing -> return $ Succeeded thing - Nothing -> return $ Failed (MissingDeclInInterface name (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps)) + Nothing -> return $ Failed $ + Can'tFindNameInInterface name + (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps) }}} where nd_doc = text "Need decl for" <+> ppr name @@ -289,8 +292,14 @@ loadSrcInterface :: SDoc loadSrcInterface doc mod want_boot maybe_pkg = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg ; case res of - Failed err -> failWithTc (TcRnMissingInterfaceError err) - Succeeded iface -> return iface } + Failed err -> + failWithTc $ + TcRnInterfaceError $ + Can'tFindInterface err $ + LookingForModule mod want_boot + Succeeded iface -> + return iface + } -- | Like 'loadSrcInterface', but returns a 'MaybeErr'. loadSrcInterface_maybe :: SDoc @@ -886,8 +895,8 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do _ -> do r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc) case r of - Failed _ - -> return r + Failed err + -> return (Failed $ BadIfaceFile err) Succeeded (iface,_fp) -> do r2 <- load_dynamic_too_maybe logger name_cache unit_state @@ -895,7 +904,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do iface loc case r2 of Failed sdoc -> return (Failed sdoc) - Succeeded {} -> return r + Succeeded {} -> return $ Succeeded (iface,_fp) err -> do trace_if logger (text "...not found") return $ Failed $ cannotFindInterface @@ -906,14 +915,18 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do err -- | Check if we need to try the dynamic interface for -dynamic-too -load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ()) +load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> ModIface -> ModLocation + -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc -- Indefinite interfaces are ALWAYS non-dynamic. | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ()) | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc | otherwise = return (Succeeded ()) -load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ()) +load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> ModIface -> ModLocation + -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case Succeeded (dynIface, _) @@ -929,7 +942,9 @@ load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do -read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr MissingInterfaceError (ModIface, FilePath)) +read_file :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> FilePath + -> IO (MaybeErr ReadInterfaceError (ModIface, FilePath)) read_file logger name_cache unit_state dflags wanted_mod file_path = do trace_if logger (text "readIFace" <+> text file_path) @@ -944,7 +959,7 @@ read_file logger name_cache unit_state dflags wanted_mod file_path = do (uninstantiateInstantiatedModule indef_mod) read_result <- readIface dflags name_cache wanted_mod' file_path case read_result of - Failed err -> return (Failed (BadIfaceFile file_path err)) + Failed err -> return (Failed err) Succeeded iface -> return (Succeeded (iface, file_path)) -- Don't forget to fill in the package name... @@ -965,7 +980,7 @@ readIface -> NameCache -> Module -> FilePath - -> IO (MaybeErr MissingInterfaceError ModIface) + -> IO (MaybeErr ReadInterfaceError ModIface) readIface dflags name_cache wanted_mod file_path = do let profile = targetProfile dflags res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path @@ -979,9 +994,9 @@ readIface dflags name_cache wanted_mod file_path = do | otherwise -> return (Failed err) where actual_mod = mi_module iface - err = HiModuleNameMismatchWarn wanted_mod actual_mod + err = HiModuleNameMismatchWarn file_path wanted_mod actual_mod - Left exn -> return (Failed (GenericException exn)) + Left exn -> return (Failed (ExceptionOccurred file_path exn)) {- ********************************************************* ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Iface.Recomp.Flags import GHC.Iface.Env import GHC.Core +import GHC.Tc.Errors.Ppr import GHC.Tc.Utils.Monad import GHC.Hs @@ -83,7 +84,6 @@ import GHC.List (uncons) import Data.Ord import Data.Containers.ListUtils import Data.Bifunctor -import GHC.Tc.Errors.Ppr (missingInterfaceErrorDiagnostic) {- ----------------------------------------------- @@ -293,8 +293,13 @@ check_old_iface hsc_env mod_summary maybe_iface read_result <- readIface read_dflags ncu (ms_mod mod_summary) iface_path case read_result of Failed err -> do - trace_if logger (text "FYI: cannot read old interface file:" $$ nest 4 (formatBulleted $ missingInterfaceErrorDiagnostic False err)) - trace_hi_diffs logger (text "Old interface file was invalid:" $$ nest 4 (formatBulleted $ missingInterfaceErrorDiagnostic False err)) + let blah = readInterfaceErrorDiagnostic err + trace_if logger + $ vcat [ text "FYI: cannot read old interface file:" + , nest 4 (formatBulleted blah) ] + trace_hi_diffs logger $ + vcat [ text "Old interface file was invalid:" + , nest 4 (formatBulleted blah) ] return Nothing Succeeded iface -> do trace_if logger (text "Read the interface file" <+> text iface_path) ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -50,6 +50,7 @@ import GHC.StgToCmm.Types import GHC.Runtime.Heap.Layout import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Ppr import GHC.Tc.TyCl.Build import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType @@ -130,7 +131,7 @@ import GHC.Unit.Module.WholeCoreBindings import Data.IORef import Data.Foldable import GHC.Builtin.Names (ioTyConName, rOOT_MAIN) -import GHC.Tc.Errors.Ppr (missingInterfaceErrorDiagnostic) + import GHC.Utils.Error {- @@ -576,13 +577,14 @@ tcHiBootIface hsc_src mod -- to check consistency against, rather than just when we notice -- that an hi-boot is necessary due to a circular import. { hsc_env <- getTopEnv - ; read_result <- liftIO $ findAndReadIface hsc_env - need (fst (getModuleInstantiation mod)) mod - IsBoot -- Hi-boot file + ; read_result <- liftIO $ findAndReadIface hsc_env need + (fst (getModuleInstantiation mod)) mod + IsBoot -- Hi-boot file ; case read_result of { - Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface - ; mkSelfBootInfo iface tc_iface } ; + Succeeded (iface, _path) -> + do { tc_iface <- initIfaceTcRn $ typecheckIface iface + ; mkSelfBootInfo iface tc_iface } ; Failed err -> -- There was no hi-boot file. But if there is circularity in @@ -598,7 +600,10 @@ tcHiBootIface hsc_src mod Nothing -> return NoSelfBoot -- error cases Just (GWIB { gwib_isBoot = is_boot }) -> case is_boot of - IsBoot -> failWithTc (TcRnMissingInterfaceError (CantFindHiBoot mod err)) + IsBoot -> + let diag = Can'tFindInterface err + (LookingForHiBoot mod) + in failWithTc (TcRnInterfaceError diag) -- The hi-boot file has mysteriously disappeared. NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop) -- Someone below us imported us! @@ -1961,7 +1966,7 @@ tcIfaceGlobal name { mb_thing <- importDecl name -- It's imported; go get it ; case mb_thing of - Failed err -> failIfM (ppr name <+> (formatBulleted $ missingInterfaceErrorDiagnostic False err)) + Failed err -> failIfM (ppr name <+> (formatBulleted $ interfaceErrorDiagnostic False err)) Succeeded thing -> return thing }}} ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -48,6 +48,7 @@ import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Finder import GHC.Tc.Utils.Monad +import GHC.Tc.Errors.Ppr import GHC.Runtime.Interpreter import GHCi.RemoteTypes @@ -120,7 +121,6 @@ import GHC.Iface.Load import GHC.Unit.Home import Data.Either import Control.Applicative -import GHC.Tc.Errors.Types (TcRnMessage(..)) uninitialised :: a uninitialised = panic "Loader not initialised" @@ -792,8 +792,9 @@ getLinkDeps hsc_env pls replace_osuf span mods mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $ loadInterface msg mod (ImportByUser NotBoot) iface <- case mb_iface of - Maybes.Failed err -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError err) + Maybes.Failed err -> + let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags + err_txt = formatBulleted $ missingInterfaceErrorDiagnostic tries err in throwGhcExceptionIO (ProgramError (showSDoc dflags err_txt)) Maybes.Succeeded iface -> return iface ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -44,6 +44,8 @@ import GHC.Core.Type ( Type, mkTyConTy ) import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( TyCon ) +import GHC.Tc.Errors.Ppr + import GHC.Types.SrcLoc ( noSrcSpan ) import GHC.Types.Name ( Name, nameModule_maybe ) import GHC.Types.Id ( idType ) @@ -52,11 +54,13 @@ import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS ) import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName , greMangledName, mkRdrQual ) +import GHC.Types.Unique.DFM import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) import GHC.Driver.Config.Finder ( initFinderOpts ) +import GHC.Driver.Config.Diagnostic ( initTcMessageOpts ) import GHC.Unit.Module ( Module, ModuleName ) -import GHC.Unit.Module.ModIface +import GHC.Unit.Module.ModIface ( ModIface_(mi_exports), ModIface ) import GHC.Unit.Env import GHC.Utils.Panic @@ -69,10 +73,8 @@ import Control.Monad ( unless ) import Data.Maybe ( mapMaybe ) import Unsafe.Coerce ( unsafeCoerce ) import GHC.Linker.Types -import GHC.Types.Unique.DFM import Data.List (unzip4) -import GHC.Tc.Errors.Types (TcRnMessage(..)) -import GHC.Driver.Config.Diagnostic (initTcMessageOpts) + -- | Loads the plugins specified in the pluginModNames field of the dynamic -- flags. Should be called after command line arguments are parsed, but before @@ -331,7 +333,9 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do Nothing -> throwCmdLineErrorS dflags $ hsep [text "Could not determine the exports of the module", ppr mod_name] err -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError (cannotFindModule hsc_env mod_name err)) + let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags + err_txt = formatBulleted $ missingInterfaceErrorDiagnostic tries + $ cannotFindModule hsc_env mod_name err in throwCmdLineErrorS dflags err_txt where doc = text "contains a name used in an invocation of lookupRdrNameInModule" ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -21,9 +21,13 @@ module GHC.Tc.Errors.Ppr , inHsDocContext , TcRnMessageOpts(..) + , interfaceErrorHints + , interfaceErrorReason + , interfaceErrorDiagnostic , missingInterfaceErrorHints , missingInterfaceErrorReason , missingInterfaceErrorDiagnostic + , readInterfaceErrorDiagnostic ) where @@ -1411,9 +1415,10 @@ instance Diagnostic TcRnMessage where hsep [ text "Unknown type variable" <> plural errorVars , text "on the RHS of injectivity condition:" , interpp'SP errorVars ] - - TcRnMissingInterfaceError reason - -> missingInterfaceErrorDiagnostic (tcOptsShowTriedFiles opts) reason + TcRnCan'tFindLocalName name + -> mkSimpleDecorated $ text "Can't find local name: " <+> ppr name + TcRnInterfaceError reason + -> interfaceErrorDiagnostic (tcOptsShowTriedFiles opts) reason diagnosticReason = \case @@ -1877,22 +1882,10 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnUnknownTyVarsOnRhsOfInjCond{} -> ErrorWithoutFlag - TcRnMissingInterfaceError reason - -> case reason of - BadSourceImport {} -> ErrorWithoutFlag - MissingDeclInInterface {} -> ErrorWithoutFlag - HomeModError {} -> ErrorWithoutFlag - DynamicHashMismatchError {} -> ErrorWithoutFlag - CantFindErr {} -> ErrorWithoutFlag - CantFindInstalledErr {} -> ErrorWithoutFlag - HiModuleNameMismatchWarn {} -> ErrorWithoutFlag - BadIfaceFile {} -> ErrorWithoutFlag - FailedToLoadDynamicInterface {} -> ErrorWithoutFlag - GenericException {} -> ErrorWithoutFlag - CantFindLocalName {} -> ErrorWithoutFlag - CantFindHiInterfaceForSig {} -> ErrorWithoutFlag - CantFindHiBoot {} -> ErrorWithoutFlag - InterfaceLookupError {} -> ErrorWithoutFlag + TcRnCan'tFindLocalName {} + -> ErrorWithoutFlag + TcRnInterfaceError err + -> interfaceErrorReason err diagnosticHints = \case @@ -2374,8 +2367,10 @@ instance Diagnostic TcRnMessage where -> noHints TcRnUnknownTyVarsOnRhsOfInjCond{} -> noHints - TcRnMissingInterfaceError reason - -> missingInterfaceErrorHints reason + TcRnCan'tFindLocalName {} + -> noHints + TcRnInterfaceError reason + -> interfaceErrorHints reason diagnosticCode = constructorCode @@ -2390,32 +2385,58 @@ commafyWith conjunction xs = addConjunction $ punctuate comma xs addConjunction (x : xs) = x : addConjunction xs addConjunction _ = panic "commafyWith expected 2 or more elements" +interfaceErrorHints :: InterfaceError -> [GhcHint] +interfaceErrorHints = \ case + Can'tFindInterface err _looking_for -> + missingInterfaceErrorHints err + Can'tFindNameInInterface {} -> + noHints + missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint] -missingInterfaceErrorHints reason = - case reason of - BadSourceImport {} -> noHints - MissingDeclInInterface {} -> noHints - HomeModError {} -> noHints - DynamicHashMismatchError {} -> noHints - CantFindErr {} -> noHints - CantFindInstalledErr {} -> noHints - HiModuleNameMismatchWarn {} -> noHints - BadIfaceFile {} -> noHints - FailedToLoadDynamicInterface {} -> noHints - GenericException {} -> noHints - CantFindLocalName {} -> noHints - CantFindHiInterfaceForSig {} -> noHints - CantFindHiBoot {} -> noHints - InterfaceLookupError {} -> noHints +missingInterfaceErrorHints = \case + BadSourceImport {} -> + noHints + HomeModError {} -> + noHints + DynamicHashMismatchError {} -> + noHints + CantFindErr {} -> + noHints + CantFindInstalledErr {} -> + noHints + BadIfaceFile {} -> + noHints + FailedToLoadDynamicInterface {} -> + noHints + +interfaceErrorReason :: InterfaceError -> DiagnosticReason +interfaceErrorReason (Can'tFindInterface err _) + = missingInterfaceErrorReason err +interfaceErrorReason (Can'tFindNameInInterface {}) + = ErrorWithoutFlag missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason -missingInterfaceErrorReason _reason = ErrorWithoutFlag +missingInterfaceErrorReason = \ case + BadSourceImport {} -> + ErrorWithoutFlag + HomeModError {} -> + ErrorWithoutFlag + DynamicHashMismatchError {} -> + ErrorWithoutFlag + CantFindErr {} -> + ErrorWithoutFlag + CantFindInstalledErr {} -> + ErrorWithoutFlag + BadIfaceFile {} -> + ErrorWithoutFlag + FailedToLoadDynamicInterface {} -> + ErrorWithoutFlag prettyCantFindWhat :: CantFindWhat -> SDoc prettyCantFindWhat CantFindModule = text "Could not find module" prettyCantFindWhat CantLoadModule = text "Could not load module" prettyCantFindWhat CantLoadInterface = text "Failed to load interface for" -prettyCantFindWhat AmbigiousModule = text "Ambiguous module name" +prettyCantFindWhat AmbiguousModule = text "Ambiguous module name" prettyCantFindWhat AmbiguousInterface = text "Ambigious interface for" cantFindError :: Bool -> CantFindInstalled -> DecoratedSDoc @@ -2493,11 +2514,18 @@ cantFindError verbose (CantFindInstalled mod_name what cfir) = in mkSimpleDecorated $ pp_suggestions ms $$ mayShowLocations verbose fps NotAModule -> mkSimpleDecorated $ text "It is not a module in the current program, or in any known package." CouldntFindInFiles fps -> mkSimpleDecorated (vcat (map text fps)) - MultiplePackages pkgs -> mkSimpleDecorated $ - sep [text "it was found in multiple packages:", - hsep (map ppr pkgs)] - MultiplePackages2 mods -> mkSimpleDecorated $ - vcat (map pprMod mods) + MultiplePackages mods + | Just pkgs <- unambiguousPackages + -> mkSimpleDecorated $ + sep [text "it was found in multiple packages:", + hsep (map ppr pkgs)] + | otherwise + -> mkSimpleDecorated $ vcat (map pprMod mods) + where + unambiguousPackages = foldl' unambiguousPackage (Just []) mods + unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) + = Just (moduleUnit m : xs) + unambiguousPackage _ _ = Nothing GenericMissing using_cabal pkg_hiddens mod_hiddens unusables files -> mkSimpleDecorated $ vcat (map (pkg_hidden using_cabal) pkg_hiddens) $$ vcat (map mod_hidden mod_hiddens) $$ @@ -2554,34 +2582,59 @@ mayShowLocations verbose files | otherwise = hang (text "Locations searched:") 2 $ vcat (map text files) +interfaceErrorDiagnostic :: Bool -> InterfaceError -> DecoratedSDoc +interfaceErrorDiagnostic verbose_files = \ case + Can'tFindInterface err looking_for -> + case looking_for of + LookingForName name -> + mkSimpleDecorated $ missingDeclInInterface name [] + LookingForModule mod is_boot -> + mkSimpleDecorated + (text "Could not find" <+> what <+> text "for" <+> quotes (ppr mod)) + `unionDecoratedSDoc` + (missingInterfaceErrorDiagnostic verbose_files err) + where + what + | IsBoot <- is_boot + = text "boot interface" + | otherwise + = text "interface" + LookingForHiBoot mod -> + mkSimpleDecorated + (text "Could not find hi-boot interface for" <+> quotes (ppr mod)) + `unionDecoratedSDoc` + (missingInterfaceErrorDiagnostic verbose_files err) + LookingForSig sig -> + mkSimpleDecorated + (text "Could not find interface file for signature" <+> quotes (ppr sig)) + `unionDecoratedSDoc` + (missingInterfaceErrorDiagnostic verbose_files err) + + Can'tFindNameInInterface name relevant_tyThings -> + mkSimpleDecorated $ missingDeclInInterface name relevant_tyThings + +readInterfaceErrorDiagnostic :: ReadInterfaceError -> DecoratedSDoc +readInterfaceErrorDiagnostic = \ case + ExceptionOccurred fp ex -> + mkSimpleDecorated $ + hang (text "Exception when reading interface file " <+> text fp) + 2 (text (showException ex)) + HiModuleNameMismatchWarn _ m1 m2 -> + mkSimpleDecorated $ hiModuleNameMismatchWarn m1 m2 + missingInterfaceErrorDiagnostic :: Bool -> MissingInterfaceError -> DecoratedSDoc missingInterfaceErrorDiagnostic verbose_files reason = case reason of BadSourceImport m -> mkSimpleDecorated $ badSourceImport m - MissingDeclInInterface name things -> mkSimpleDecorated $ missingDeclInInterface name things HomeModError im ml -> mkSimpleDecorated $ homeModError im ml DynamicHashMismatchError m ml -> mkSimpleDecorated $ dynamicHashMismatchError m ml CantFindErr us cfi -> mkDecorated . map (pprWithUnitState us) . unDecorated $ cantFindError verbose_files cfi CantFindInstalledErr cfi -> cantFindError verbose_files cfi - HiModuleNameMismatchWarn m1 m2 -> mkSimpleDecorated $ hiModuleNameMismatchWarn m1 m2 - BadIfaceFile fp mie -> - -- TODO - mkSimpleDecorated (text fp) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie + BadIfaceFile rie -> readInterfaceErrorDiagnostic rie FailedToLoadDynamicInterface wanted_mod err -> mkSimpleDecorated (text "Failed to load dynamic interface file for" <+> ppr wanted_mod) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files err - GenericException se -> --- mkSimpleDecorated $ text "Exception when reading interface file for" <+> ppr mod - mkSimpleDecorated $ text (showException se) - CantFindLocalName name -> mkSimpleDecorated (text "Can't find local name: " <+> ppr name) - CantFindHiInterfaceForSig isig_mod mie -> - mkSimpleDecorated (text "Could not find hi interface for signature" <+> quotes (ppr isig_mod)) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie - CantFindHiBoot m mie -> - mkSimpleDecorated (text "Could not find hi-boot interface for" <+> quotes (ppr m)) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie - InterfaceLookupError _ mie -> missingInterfaceErrorDiagnostic verbose_files mie + `unionDecoratedSDoc` + readInterfaceErrorDiagnostic err hiModuleNameMismatchWarn :: Module -> Module -> SDoc hiModuleNameMismatchWarn requested_mod read_mod @@ -2626,9 +2679,9 @@ missingDeclInInterface :: Name -> [TyThing] -> SDoc missingDeclInInterface name things = whenPprDebug (found_things $$ empty) $$ hang (text "Can't find interface-file declaration for" <+> - pprNameSpace (nameNameSpace name) <+> ppr name) - 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", - text "Use -ddump-if-trace to get an idea of which file caused the error"]) + pprNameSpace (nameNameSpace name) <+> ppr name) + 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", + text "Use -ddump-if-trace to get an idea of which file caused the error"]) where found_things = hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon) ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -49,6 +49,9 @@ module GHC.Tc.Errors.Types ( , FixedRuntimeRepErrorInfo(..) , MissingInterfaceError(..) + , InterfaceLookingFor(..) + , InterfaceError(..) + , ReadInterfaceError(..) , CantFindInstalled(..) , CantFindInstalledReason(..) , CantFindWhat(..) @@ -112,6 +115,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , FixedRuntimeRepOrigin(..) ) import GHC.Tc.Types.Rank (Rank) import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType) +import GHC.Types.Basic import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) import GHC.Types.ForeignCall (CLabelString) @@ -137,7 +141,6 @@ import GHC.Core.TyCon (TyCon, TyConFlavour) import GHC.Core.Type (Kind, Type, ThetaType, PredType) import GHC.Driver.Backend (Backend) import GHC.Unit.State (UnitState, ModuleSuggestion, ModuleOrigin, UnusableUnitReason, UnitInfo) -import GHC.Types.Basic import GHC.Utils.Misc (capitalise, filterOut) import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString (FastString) @@ -3178,7 +3181,9 @@ data TcRnMessage where -} TcRnUnknownTyVarsOnRhsOfInjCond :: [Name] -> TcRnMessage - TcRnMissingInterfaceError :: !MissingInterfaceError -> TcRnMessage + TcRnCan'tFindLocalName :: !Name -> TcRnMessage + + TcRnInterfaceError :: !InterfaceError -> TcRnMessage deriving Generic @@ -3598,41 +3603,61 @@ instance Outputable Exported where ppr IsNotExported = text "IsNotExported" ppr IsExported = text "IsExported" -data MissingInterfaceError = - BadSourceImport !Module - | MissingDeclInInterface !Name [TyThing] - | HomeModError !InstalledModule !ModLocation - | DynamicHashMismatchError !Module !ModLocation - | HiModuleNameMismatchWarn Module Module - | CantFindLocalName Name - -- dodgy? - | GenericException SomeException - -- Can't find errors - | CantFindErr !UnitState CantFindInstalled - | CantFindInstalledErr CantFindInstalled - -- Adding context - | BadIfaceFile FilePath MissingInterfaceError - | FailedToLoadDynamicInterface Module MissingInterfaceError - | CantFindHiInterfaceForSig InstalledModule MissingInterfaceError - | CantFindHiBoot Module MissingInterfaceError - | InterfaceLookupError Name MissingInterfaceError - deriving Generic - -data CantFindInstalledReason = NoUnitIdMatching UnitId [UnitInfo] - | MissingPackageFiles UnitId [FilePath] - | MissingPackageWayFiles String UnitId [FilePath] - | ModuleSuggestion [ModuleSuggestion] [FilePath] - | NotAModule - | CouldntFindInFiles [FilePath] - | GenericMissing BuildingCabalPackage [(Unit, Maybe UnitInfo)] [Unit] [(Unit, UnusableUnitReason)] [FilePath] - -- Ambiguous - | MultiplePackages [Unit] - | MultiplePackages2 [(Module, ModuleOrigin)] - deriving Generic - -data CantFindInstalled = CantFindInstalled ModuleName CantFindWhat CantFindInstalledReason deriving Generic - -data CantFindWhat = CantFindModule | CantLoadModule | CantLoadInterface | AmbiguousInterface | AmbigiousModule +data InterfaceLookingFor + = LookingForName !Name + | LookingForHiBoot !Module + | LookingForModule !ModuleName !IsBootInterface + | LookingForSig !InstalledModule + +data InterfaceError + = Can'tFindInterface + MissingInterfaceError + InterfaceLookingFor + | Can'tFindNameInInterface + Name + [TyThing] -- possibly relevant TyThings + deriving Generic + +data MissingInterfaceError + = BadSourceImport !Module + | HomeModError !InstalledModule !ModLocation + | DynamicHashMismatchError !Module !ModLocation + + -- TODO: common up these two + | CantFindErr !UnitState CantFindInstalled + | CantFindInstalledErr CantFindInstalled + + | BadIfaceFile ReadInterfaceError + | FailedToLoadDynamicInterface Module ReadInterfaceError + deriving Generic + +data ReadInterfaceError + = ExceptionOccurred FilePath SomeException + | HiModuleNameMismatchWarn FilePath Module Module + deriving Generic + +data CantFindInstalledReason + = NoUnitIdMatching UnitId [UnitInfo] + | MissingPackageFiles UnitId [FilePath] + | MissingPackageWayFiles String UnitId [FilePath] + | ModuleSuggestion [ModuleSuggestion] [FilePath] + | NotAModule + | CouldntFindInFiles [FilePath] + | GenericMissing BuildingCabalPackage + [(Unit, Maybe UnitInfo)] [Unit] + [(Unit, UnusableUnitReason)] [FilePath] + | MultiplePackages [(Module, ModuleOrigin)] + deriving Generic + +data CantFindInstalled = + CantFindInstalled ModuleName CantFindWhat CantFindInstalledReason + deriving Generic + +data CantFindWhat + = CantFindModule | CantLoadModule | CantLoadInterface + | AmbiguousInterface | AmbiguousModule + -- TODO? + -------------------------------------------------------------------------------- -- -- Errors used in GHC.Tc.Errors ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2024,7 +2024,7 @@ tcLookupTh name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return (AGlobal thing) - Failed msg -> failWithTc (TcRnMissingInterfaceError (InterfaceLookupError name msg)) + Failed msg -> failWithTc (TcRnInterfaceError msg) }}}} notInScope :: TH.Name -> TcRnMessage ===================================== compiler/GHC/Tc/Utils/Backpack.hs ===================================== @@ -168,7 +168,7 @@ checkHsigIface tcg_env gr sig_iface -- tcg_env (TODO: but maybe this isn't relevant anymore). r <- tcLookupImported_maybe name case r of - Failed err -> addErr (TcRnMissingInterfaceError (InterfaceLookupError name err)) + Failed err -> addErr (TcRnInterfaceError err) Succeeded real_thing -> checkHsigDeclM sig_iface sig_thing real_thing -- The hsig did NOT define this function; that means it must @@ -564,8 +564,7 @@ mergeSignatures ctx = initSDocContext dflags defaultUserStyle fmap fst . withIfaceErr ctx - $ findAndReadIface hsc_env - (text "mergeSignatures") im m NotBoot + $ findAndReadIface hsc_env (text "mergeSignatures") im m NotBoot -- STEP 3: Get the unrenamed exports of all these interfaces, -- thin it according to the export list, and do shaping on them. @@ -996,11 +995,9 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do isig_mod sig_mod NotBoot isig_iface <- case mb_isig_iface of Succeeded (iface, _) -> return iface - Failed err -> failWithTc $ TcRnMissingInterfaceError $ CantFindHiInterfaceForSig isig_mod err - {- - hang (text "Could not find hi interface for signature" <+> - quotes (ppr isig_mod) <> colon) 4 err - -} + Failed err -> + failWithTc $ TcRnInterfaceError $ + Can'tFindInterface err (LookingForSig isig_mod) -- STEP 3: Check that the implementing interface exports everything -- we need. (Notice we IGNORE the Modules in the AvailInfos.) ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -153,12 +153,13 @@ lookupGlobal hsc_env name mb_thing <- lookupGlobal_maybe hsc_env name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts (hsc_dflags hsc_env)) (TcRnMissingInterfaceError msg) + Failed err -> + let err_txt = formatBulleted + $ diagnosticMessage (initTcMessageOpts (hsc_dflags hsc_env)) + err in pprPanic "lookupGlobal" err_txt } - -lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) +lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr TcRnMessage TyThing) -- This may look up an Id that one has previously looked up. -- If so, we are going to read its interface file, and add its bindings -- to the ExternalPackageTable. @@ -169,24 +170,26 @@ lookupGlobal_maybe hsc_env name tcg_semantic_mod = homeModuleInstantiation mhome_unit mod ; if nameIsLocalOrFrom tcg_semantic_mod name - then (return - (Failed (CantFindLocalName name))) - -- Internal names can happen in GHCi - else - -- Try home package table and external package table - lookupImported_maybe hsc_env name + then return $ Failed $ TcRnCan'tFindLocalName name + -- Internal names can happen in GHCi + else do + res <- lookupImported_maybe hsc_env name + -- Try home package table and external package table + return $ case res of + Succeeded ok -> Succeeded ok + Failed err -> Failed (TcRnInterfaceError err) } -lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) +lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr InterfaceError TyThing) -- Returns (Failed err) if we can't find the interface file for the thing lookupImported_maybe hsc_env name = do { mb_thing <- lookupType hsc_env name ; case mb_thing of Just thing -> return (Succeeded thing) Nothing -> importDecl_maybe hsc_env name - } + } -importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) +importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr InterfaceError TyThing) importDecl_maybe hsc_env name | Just thing <- wiredInNameTyThing_maybe name = do { when (needWiredInHomeIface thing) @@ -245,7 +248,7 @@ tcLookupGlobal name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> failWithTc (TcRnMissingInterfaceError (InterfaceLookupError name msg)) + Failed msg -> failWithTc (TcRnInterfaceError msg) }}} -- Look up only in this module's global env't. Don't look in imports, etc. ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -217,6 +218,7 @@ import Data.IORef import Control.Monad import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Ppr import {-# SOURCE #-} GHC.Tc.Utils.Env ( tcInitTidyEnv ) import qualified Data.Map as Map @@ -668,8 +670,8 @@ withIfaceErr ctx do_this = do r <- do_this case r of Failed err -> do - let diag = TcRnMissingInterfaceError err - msg = pprDiagnostic diag + let tries = tcOptsShowTriedFiles $ defaultDiagnosticOpts @TcRnMessage + msg = formatBulleted $ missingInterfaceErrorDiagnostic tries err liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx msg)) Succeeded result -> return result ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -530,6 +530,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnShadowedTyVarNameInFamResult" = 99412 GhcDiagnosticCode "TcRnIncorrectTyVarOnLhsOfInjCond" = 88333 GhcDiagnosticCode "TcRnUnknownTyVarsOnRhsOfInjCond" = 48254 + GhcDiagnosticCode "TcRnCan'tFindLocalName" = 11111 -- SLD TODO -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 @@ -583,32 +584,27 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "OneArgExpected" = 91490 GhcDiagnosticCode "AtLeastOneArgExpected" = 07641 - -- Missing interface errors + -- Interface errors GhcDiagnosticCode "BadSourceImport" = 00001 - GhcDiagnosticCode "MissingDeclInInterface" = 00002 - GhcDiagnosticCode "MissingInterfaceError" = 00003 - GhcDiagnosticCode "HomeModError" = 00004 - GhcDiagnosticCode "DynamicHashMismatchError" = 00005 - GhcDiagnosticCode "BadIfaceFile" = 00006 - GhcDiagnosticCode "CantFindLocalName" = 00009 - GhcDiagnosticCode "FailedToLoadDynamicInterface" = 00010 - GhcDiagnosticCode "GenericException" = 00011 - GhcDiagnosticCode "HiModuleNameMismatch" = 00012 - GhcDiagnosticCode "HiModuleNameMismatchWarn" = 00013 - GhcDiagnosticCode "UsedAsDataConstructor" = 00014 - GhcDiagnosticCode "CantFindHiInterfaceForSig" = 00015 - - GhcDiagnosticCode "CouldntFindInFiles" = 00016 - GhcDiagnosticCode "GenericMissing" = 00017 - GhcDiagnosticCode "MissingPackageFiles" = 00018 - GhcDiagnosticCode "MissingPackageWayFiles" = 00019 - GhcDiagnosticCode "ModuleSuggestion" = 00020 - GhcDiagnosticCode "MultiplePackages" = 00021 - GhcDiagnosticCode "MultiplePackages2" = 00022 - GhcDiagnosticCode "NoUnitIdMatching" = 00023 - GhcDiagnosticCode "NotAModule" = 00024 - GhcDiagnosticCode "CantFindHiBoot" = 00025 - + GhcDiagnosticCode "MissingDeclInInterface" = 00002 + GhcDiagnosticCode "MissingInterfaceError" = 00003 + GhcDiagnosticCode "HomeModError" = 00004 + GhcDiagnosticCode "DynamicHashMismatchError" = 00005 + GhcDiagnosticCode "BadIfaceFile" = 00006 + GhcDiagnosticCode "FailedToLoadDynamicInterface" = 00010 + GhcDiagnosticCode "UsedAsDataConstructor" = 00014 + GhcDiagnosticCode "CouldntFindInFiles" = 00016 + GhcDiagnosticCode "GenericMissing" = 00017 + GhcDiagnosticCode "MissingPackageFiles" = 00018 + GhcDiagnosticCode "MissingPackageWayFiles" = 00019 + GhcDiagnosticCode "ModuleSuggestion" = 00020 + GhcDiagnosticCode "MultiplePackages" = 00022 + GhcDiagnosticCode "NoUnitIdMatching" = 00023 + GhcDiagnosticCode "NotAModule" = 00024 + GhcDiagnosticCode "Can'tFindNameInInterface" = 00026 + + GhcDiagnosticCode "HiModuleNameMismatchWarn" = 00012 + GhcDiagnosticCode "ExceptionOccurred" = 00011 -- Out of scope errors GhcDiagnosticCode "NotInScope" = 76037 @@ -702,13 +698,10 @@ type family ConRecursInto con where ConRecursInto "CantFindErr" = 'Just CantFindInstalled ConRecursInto "CantFindInstalledErr" = 'Just CantFindInstalled - ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason + ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason - ConRecursInto "BadIfaceFile" = 'Just MissingInterfaceError - ConRecursInto "FailedToLoadDynamicInterface" = 'Just MissingInterfaceError - ConRecursInto "CantFindHiInterfaceForSig" = 'Just MissingInterfaceError - ConRecursInto "CantFindHiBoot" = 'Just MissingInterfaceError - ConRecursInto "InterfaceLookupError" = 'Just MissingInterfaceError + ConRecursInto "BadIfaceFile" = 'Just ReadInterfaceError + ConRecursInto "FailedToLoadDynamicInterface" = 'Just ReadInterfaceError ---------------------------------- -- Constructors of PsMessage @@ -737,7 +730,10 @@ type family ConRecursInto con where ConRecursInto "TcRnRunSpliceFailure" = 'Just RunSpliceFailReason ConRecursInto "ConversionFail" = 'Just ConversionFailReason - ConRecursInto "TcRnMissingInterfaceError" = 'Just MissingInterfaceError + -- Interface file errors + + ConRecursInto "TcRnInterfaceError" = 'Just InterfaceError + ConRecursInto "Can'tFindInterface" = 'Just MissingInterfaceError ------------------ -- FFI errors View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/253385ee13203425aa89f78d3159dfe6e52216a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/253385ee13203425aa89f78d3159dfe6e52216a2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 16:02:57 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 15 Mar 2023 12:02:57 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] 2 commits: Hardwire a better unit-id for ghc Message-ID: <6411ec31efa9d_37e76b22566c48312948@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 3286a288 by romes at 2023-03-15T16:00:19+00:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 5e2ac5fe by romes at 2023-03-15T16:01:20+00:00 Validate compatibility of ghcs when loading plugins - - - - - 10 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Unit/Types.hs - compiler/Setup.hs - compiler/ghc.cabal.in - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Packages.hs - testsuite/tests/driver/j-space/jspace.hs - utils/count-deps/Main.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -4703,6 +4703,7 @@ compilerInfo dflags ("Project Patch Level", cProjectPatchLevel), ("Project Patch Level1", cProjectPatchLevel1), ("Project Patch Level2", cProjectPatchLevel2), + ("Project Unit Id", cProjectUnitId), ("Booter version", cBooterVersion), ("Stage", cStage), ("Build platform", cBuildPlatformString), ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -42,10 +42,10 @@ import GHC.Driver.Env import GHCi.RemoteTypes ( HValue ) import GHC.Core.Type ( Type, mkTyConTy ) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.TyCon ( TyCon ) +import GHC.Core.TyCon ( TyCon(tyConName) ) import GHC.Types.SrcLoc ( noSrcSpan ) -import GHC.Types.Name ( Name, nameModule_maybe ) +import GHC.Types.Name ( Name, nameModule, nameModule_maybe ) import GHC.Types.Id ( idType ) import GHC.Types.TyThing import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS ) @@ -55,7 +55,7 @@ import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) import GHC.Driver.Config.Finder ( initFinderOpts ) -import GHC.Unit.Module ( Module, ModuleName ) +import GHC.Unit.Module ( Module, ModuleName, thisGhcUnit, GenModule(moduleUnit) ) import GHC.Unit.Module.ModIface import GHC.Unit.Env @@ -171,7 +171,14 @@ loadPlugin' occ_name plugin_name hsc_env mod_name Just (name, mod_iface) -> do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name - ; eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) + ; case thisGhcUnit == (moduleUnit . nameModule . tyConName) plugin_tycon of { + False -> + throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep + [ text "The plugin module", ppr mod_name + , text "was built with a compiler that is incompatible with the one loading it" + ]) ; + True -> + do { eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) ; case eith_plugin of Left actual_type -> throwGhcExceptionIO (CmdLineError $ @@ -182,7 +189,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name , text "did not have the type" , text "GHC.Plugins.Plugin" , text "as required"]) - Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } + Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } } } -- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used ===================================== compiler/GHC/Unit/Types.hs ===================================== @@ -99,6 +99,7 @@ import GHC.Data.FastString import GHC.Utils.Encoding import GHC.Utils.Fingerprint import GHC.Utils.Misc +import GHC.Settings.Config (cProjectUnitId) import Control.DeepSeq import Data.Data @@ -597,7 +598,7 @@ primUnitId = UnitId (fsLit "ghc-prim") bignumUnitId = UnitId (fsLit "ghc-bignum") baseUnitId = UnitId (fsLit "base") rtsUnitId = UnitId (fsLit "rts") -thisGhcUnitId = UnitId (fsLit "ghc") +thisGhcUnitId = UnitId (fsLit cProjectUnitId) -- See Note [GHC's Unit Id] interactiveUnitId = UnitId (fsLit "interactive") thUnitId = UnitId (fsLit "template-haskell") @@ -625,8 +626,49 @@ wiredInUnitIds = , baseUnitId , rtsUnitId , thUnitId - , thisGhcUnitId ] + -- NB: ghc is no longer part of the wired-in units since its unit-id, given + -- by hadrian or cabal, is no longer overwritten and now matches both the + -- cProjectUnitId defined in build-time-generated module GHC.Version, and + -- the unit key. + -- + -- See also Note [About units], taking into consideration ghc is still a + -- wired-in unit but whose unit-id no longer needs special handling because + -- we take care that it matches the unit key. + +{- +Note [GHC's Unit Id] +~~~~~~~~~~~~~~~~~~~~ +Previously, the unit-id of ghc-the-library was fixed as `ghc`. +This was done primarily because the compiler must know the unit-id of +some packages (including ghc) a-priori to define wired-in names. + +However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed +to `ghc` might result in subtle bugs when different ghc's interact. + +A good example of this is having GHC_A load a plugin compiled by GHC_B, +where GHC_A and GHC_B are linked to ghc-libraries that are ABI +incompatible. Without a distinction between the unit-id of the ghc library +GHC_A is linked against and the ghc library the plugin it is loading was +compiled against, we can't check compatibility. + +Now, we give a better unit-id to ghc (`ghc-version-hash`) by + +(1) Not setting -this-unit-id fixed to `ghc` in `ghc.cabal`, but rather by having + (1.1) Hadrian pass the new unit-id with -this-unit-id for stage0-1 + (1.2) Cabal pass the unit-id it computes to ghc, which it already does by default + +(2) Adding a definition to `GHC.Settings.Config` whose value is the new +unit-id. This is crucial to define the wired-in name of the GHC unit +(`thisGhcUnitId`) which *must* match the value of the -this-unit-id flag. +(Where `GHC.Settings.Config` is a module generated by the build system which, +be it either hadrian or cabal, knows exactly the unit-id it passed with -this-unit-id) + +Note that we also ensure the ghc's unit key matches its unit id, both when +hadrian or cabal is building ghc. This way, we no longer need to add `ghc` to +the WiringMap, and that's why 'wiredInUnitIds' no longer includes +'thisGhcUnitId'. +-} --------------------------------------------------------------------- -- Boot Modules ===================================== compiler/Setup.hs ===================================== @@ -3,7 +3,10 @@ module Main where import Distribution.Simple import Distribution.Simple.BuildPaths +import Distribution.Types.ComponentLocalBuildInfo +import Distribution.Types.ComponentName (ComponentName(CLibName)) import Distribution.Types.LocalBuildInfo +import Distribution.Types.LibraryName (LibraryName(LMainLibName)) import Distribution.Verbosity import Distribution.Simple.Program import Distribution.Simple.Utils @@ -15,6 +18,7 @@ import System.Directory import System.FilePath import Control.Monad import Data.Char +import qualified Data.Map as Map import GHC.ResponseFile import System.Environment @@ -85,9 +89,13 @@ ghcAutogen verbosity lbi at LocalBuildInfo{..} = do callProcess "deriveConstants" ["--gen-haskell-type","-o",tmp,"--target-os",targetOS] renameFile tmp platformConstantsPath + let cProjectUnitId = case Map.lookup (CLibName LMainLibName) componentNameMap of + Just [LibComponentLocalBuildInfo{componentUnitId}] -> unUnitId componentUnitId + _ -> error "Couldn't find unique cabal library when building ghc" + -- Write GHC.Settings.Config - let configHsPath = autogenPackageModulesDir lbi "GHC/Settings/Config.hs" - configHs = generateConfigHs settings + configHsPath = autogenPackageModulesDir lbi "GHC/Settings/Config.hs" + configHs = generateConfigHs cProjectUnitId settings createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath) rewriteFileEx verbosity configHsPath configHs @@ -98,8 +106,9 @@ getSetting settings kh kr = go settings kr Nothing -> Left (show k ++ " not found in settings: " ++ show settings) Just v -> Right v -generateConfigHs :: [(String,String)] -> String -generateConfigHs settings = either error id $ do +generateConfigHs :: String -- ^ ghc's cabal-generated unit-id, which matches its package-id/key + -> [(String,String)] -> String +generateConfigHs cProjectUnitId settings = either error id $ do let getSetting' = getSetting $ (("cStage","2"):) settings buildPlatform <- getSetting' "cBuildPlatformString" "Host platform" hostPlatform <- getSetting' "cHostPlatformString" "Target platform" @@ -114,6 +123,7 @@ generateConfigHs settings = either error id $ do , " , cProjectName" , " , cBooterVersion" , " , cStage" + , " , cProjectUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -134,4 +144,7 @@ generateConfigHs settings = either error id $ do , "" , "cStage :: String" , "cStage = show ("++ cStage ++ " :: Int)" + , "" + , "cProjectUnitId :: String" + , "cProjectUnitId = " ++ show cProjectUnitId ] ===================================== compiler/ghc.cabal.in ===================================== @@ -39,7 +39,7 @@ extra-source-files: custom-setup - setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.10, directory, process, filepath + setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.10, directory, process, filepath, containers Flag internal-interpreter Description: Build with internal interpreter support. @@ -57,6 +57,12 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +-- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` +Flag hadrian-stage0 + Description: Enable if compiling the stage0 compiler with hadrian + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -136,9 +142,10 @@ Library Include-Dirs: . - -- We need to set the unit id to ghc (without a version number) - -- as it's magic. - GHC-Options: -this-unit-id ghc + if flag(hadrian-stage0) + -- We need to set the unit id to ghc (without a version number) + -- as it's magic. + GHC-Options: -this-unit-id ghc c-sources: cbits/cutils.c ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -486,6 +486,16 @@ generateConfigHs = do trackGenerateHs cProjectName <- getSetting ProjectName cBooterVersion <- getSetting GhcVersion + cProjectVersionMunged <- getSetting ProjectVersionMunged + -- ROMES:TODO:HASH First we attempt a fixed unit-id with version but without hash. + -- + -- We now use a more informative unit-id for ghc. See Note [GHC's Unit Id] + -- in GHC.Unit.Types + -- + -- It's crucial that the unit-id matches the unit-key -- ghc is no longer + -- part of the WiringMap, so we don't to go back and forth between the + -- unit-id and the unit-key -- we take care here that they are the same. + let cProjectUnitId = "ghc-" ++ cProjectVersionMunged -- ROMES:TODO:HASH return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -494,6 +504,7 @@ generateConfigHs = do , " , cProjectName" , " , cBooterVersion" , " , cStage" + , " , cProjectUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -514,6 +525,9 @@ generateConfigHs = do , "" , "cStage :: String" , "cStage = show (" ++ stageString stage ++ " :: Int)" + , "" + , "cProjectUnitId :: String" + , "cProjectUnitId = " ++ show cProjectUnitId ] where stageString (Stage0 InTreeLibs) = "1" @@ -533,6 +547,7 @@ generateVersionHs = do cProjectPatchLevel <- getSetting ProjectPatchLevel cProjectPatchLevel1 <- getSetting ProjectPatchLevel1 cProjectPatchLevel2 <- getSetting ProjectPatchLevel2 + return $ unlines [ "module GHC.Version where" , "" ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -247,6 +247,16 @@ packageGhcArgs :: Args packageGhcArgs = do package <- getPackage ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) + -- ROMES: Until the boot compiler no longer needs ghc's + -- unit-id to be "ghc", the stage0 compiler must be built + -- with `-this-unit-id ghc`, while the wired-in unit-id of + -- ghc is correctly set to the unit-id we'll generate for + -- stage1 (set in generateVersionHs in Rules.Generate). + -- + -- However, we don't need to set the unit-id of "ghc" to "ghc" when + -- building stage0 because we have a flag in compiler/ghc.cabal.in that is + -- sets `-this-unit-id ghc` when hadrian is building stage0, which will + -- overwrite this one. pkgId <- expr $ pkgIdentifier package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -77,6 +77,11 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + -- ROMES: While the boot compiler is not updated wrt -this-unit-id + -- not being fixed to `ghc`, when building stage0, we must set + -- -this-unit-id to `ghc` because the boot compiler expects that. + -- We do it through a cabal flag in ghc.cabal + , stage0 ? arg "+hadrian-stage0" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] ===================================== testsuite/tests/driver/j-space/jspace.hs ===================================== @@ -2,6 +2,7 @@ module Main where import GHC import GHC.Driver.Monad +import GHC.Driver.Session import System.Environment import GHC.Driver.Env.Types import GHC.Profiling @@ -25,6 +26,9 @@ initGhcM xs = do let cmdOpts = ["-fforce-recomp"] ++ xs (df2, leftovers, _) <- parseDynamicFlags (hsc_logger session) df1 (map noLoc cmdOpts) setSessionDynFlags df2 + ghcUnitId <- case lookup "Project Unit Id" (compilerInfo df2) of + Nothing -> fail "failed to find ghc's unit-id in the compiler info" + Just ghcUnitId -> pure ghcUnitId ts <- mapM (\s -> guessTarget s Nothing Nothing) $ map unLoc leftovers setTargets ts _ <- load LoadAllTargets @@ -36,7 +40,7 @@ initGhcM xs = do liftIO $ do requestHeapCensus performGC - [ys] <- filter (isPrefixOf "ghc:GHC.Unit.Module.ModDetails.ModDetails") . lines <$> readFile "jspace.hp" + [ys] <- filter (isPrefixOf (ghcUnitId <> ":GHC.Unit.Module.ModDetails.ModDetails")) . lines <$> readFile "jspace.hp" let (n :: Int) = read (last (words ys)) -- The output should be 50 * 8 * word_size (i.e. 3200, or 1600 on 32-bit architectures): -- the test contains DEPTH + WIDTH + 2 = 50 modules J, H_0, .., H_DEPTH, W_1, .., W_WIDTH, ===================================== utils/count-deps/Main.hs ===================================== @@ -56,25 +56,28 @@ calcDeps modName libdir = logger <- getLogger (df, _, _) <- parseDynamicFlags logger df [noLoc "-package=ghc"] setSessionDynFlags df - env <- getSession - loop env Map.empty [mkModuleName modName] + case lookup "Project Unit Id" (compilerInfo df) of + Nothing -> fail "failed to find ghc's unit-id in the compiler info" + Just ghcUnitId -> do + env <- getSession + loop ghcUnitId env Map.empty [mkModuleName modName] where -- Source imports are only guaranteed to show up in the 'mi_deps' -- of modules that import them directly and don’t propagate -- transitively so we loop. - loop :: HscEnv -> Map.Map ModuleName [ModuleName] -> [ModuleName] -> Ghc (Map.Map ModuleName [ModuleName]) - loop env modules (m : ms) = + loop :: String -> HscEnv -> Map.Map ModuleName [ModuleName] -> [ModuleName] -> Ghc (Map.Map ModuleName [ModuleName]) + loop ghcUnitId env modules (m : ms) = if m `Map.member` modules - then loop env modules ms + then loop ghcUnitId env modules ms else do - mi <- liftIO $ hscGetModuleInterface env (mkModule m) + mi <- liftIO $ hscGetModuleInterface env (mkModule ghcUnitId m) let deps = modDeps mi modules <- return $ Map.insert m [] modules - loop env (Map.insert m deps modules) $ ms ++ filter (not . (`Map.member` modules)) deps - loop _ modules [] = return modules + loop ghcUnitId env (Map.insert m deps modules) $ ms ++ filter (not . (`Map.member` modules)) deps + loop _ _ modules [] = return modules - mkModule :: ModuleName -> Module - mkModule = Module (stringToUnit "ghc") + mkModule :: String -> ModuleName -> Module + mkModule ghcUnitId = Module (stringToUnit ghcUnitId) modDeps :: ModIface -> [ModuleName] modDeps mi = map (gwib_mod . snd) $ Set.toList $ dep_direct_mods (mi_deps mi) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74411c8bbaf14398b965259e6ea8b8838d92b579...5e2ac5fe70a6d5ace9d6bb5eabd4f01db45e8bf2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74411c8bbaf14398b965259e6ea8b8838d92b579...5e2ac5fe70a6d5ace9d6bb5eabd4f01db45e8bf2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 17:30:21 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 15 Mar 2023 13:30:21 -0400 Subject: [Git][ghc/ghc][wip/T23051] Wibble Message-ID: <641200aded00e_37e76b23df91ac326087@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23051 at Glasgow Haskell Compiler / GHC Commits: 129f8925 by Simon Peyton Jones at 2023-03-15T17:30:25+00:00 Wibble - - - - - 2 changed files: - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Utils/TcMType.hs Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -3547,8 +3547,12 @@ kindGeneralizeSome skol_info wanted kind_or_type -- here will already have all type variables quantified; -- thus, every free variable is really a kv, never a tv. ; dvs <- candidateQTyVarsOfKind kind_or_type - ; dvs <- filterConstrainedCandidates wanted dvs - ; quantifyTyVars skol_info DefaultNonStandardTyVars dvs } + ; filtered_dvs <- filterConstrainedCandidates wanted dvs + ; traceTc "kindGeneralizeSome" $ + vcat [ text "type:" <+> ppr kind_or_type + , text "dvs:" <+> ppr dvs + , text "filtered_dvs:" <+> ppr filtered_dvs ] + ; quantifyTyVars skol_info DefaultNonStandardTyVars filtered_dvs } filterConstrainedCandidates :: WantedConstraints -- Don't quantify over variables free in these ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1443,10 +1443,14 @@ collect_cand_qtvs orig_ty is_dep cur_lvl bound dvs ty = return dv -- This variable is from an outer context; skip -- See Note [Use level numbers for quantification] --- | case tcTyVarDetails tv of --- SkolemTv _ lvl _ -> lvl > pushTcLevel cur_lvl --- _ -> False --- -> return dv -- Skip inner skolems; ToDo: explain + | case tcTyVarDetails tv of + SkolemTv _ lvl _ -> True -- lvl > pushTcLevel cur_lvl + _ -> False + = return dv -- Skip inner skolems + -- This only happens for erroneous program with bad telescopes + -- e.g. BadTelescope2: forall a k (b :: k). SameKind a b + -- We have (a::k), and at the outer we don't want to quantify + -- over the already-quantified skolem k. | tv `elemDVarSet` kvs = return dv -- We have met this tyvar already View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/129f8925ad710a57a9ecde766eafdcda24d6c071 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/129f8925ad710a57a9ecde766eafdcda24d6c071 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 17:58:33 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 15 Mar 2023 13:58:33 -0400 Subject: [Git][ghc/ghc][wip/T23051] Drop dead binding Message-ID: <6412074981420_37e76b24532fa4334359@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23051 at Glasgow Haskell Compiler / GHC Commits: 35616f41 by Simon Peyton Jones at 2023-03-15T18:00:07+00:00 Drop dead binding - - - - - 1 changed file: - compiler/GHC/Tc/Utils/TcMType.hs Changes: ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1444,8 +1444,8 @@ collect_cand_qtvs orig_ty is_dep cur_lvl bound dvs ty -- See Note [Use level numbers for quantification] | case tcTyVarDetails tv of - SkolemTv _ lvl _ -> True -- lvl > pushTcLevel cur_lvl - _ -> False + SkolemTv {} -> True -- lvl > pushTcLevel cur_lvl + _ -> False = return dv -- Skip inner skolems -- This only happens for erroneous program with bad telescopes -- e.g. BadTelescope2: forall a k (b :: k). SameKind a b View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/35616f4145c0cdb83e815a967e70afd944ad4851 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/35616f4145c0cdb83e815a967e70afd944ad4851 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 20:38:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 15 Mar 2023 16:38:33 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23071 Message-ID: <64122cc9c293d_37e76b26ed526c3473c4@gitlab.mail> Ben Gamari pushed new branch wip/T23071 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23071 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 20:42:18 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 15 Mar 2023 16:42:18 -0400 Subject: [Git][ghc/ghc][wip/T23071] testsuite: Add test for #23071 Message-ID: <64122daaccc2d_37e76b26ed52bc353988@gitlab.mail> Ben Gamari pushed to branch wip/T23071 at Glasgow Haskell Compiler / GHC Commits: 2b6fb440 by Ben Gamari at 2023-03-15T16:41:34-04:00 testsuite: Add test for #23071 - - - - - 2 changed files: - + testsuite/tests/primops/should_run/T23071.hs - testsuite/tests/primops/should_run/all.T Changes: ===================================== testsuite/tests/primops/should_run/T23071.hs ===================================== @@ -0,0 +1,5 @@ +import Control.Monad +import GHC.Conc.Sync + +main = replicateM_ 1000000 $ listThreads >>= print + ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -60,3 +60,4 @@ test('UnliftedTVar2', normal, compile_and_run, ['']) test('UnliftedWeakPtr', normal, compile_and_run, ['']) test('T21624', normal, compile_and_run, ['']) +test('T23071', ignore_stdout, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b6fb4408d14d948af89018d70de26fb7686e02d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b6fb4408d14d948af89018d70de26fb7686e02d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 22:08:21 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 15 Mar 2023 18:08:21 -0400 Subject: [Git][ghc/ghc][wip/expand-do] rec do compiles but compiled code loops forever. I think I have broken the... Message-ID: <641241d5c04b5_37e76b2876bbc8363468@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 5af2773c by Apoorv Ingle at 2023-03-15T17:08:07-05:00 rec do compiles but compiled code loops forever. I think I have broken the mfix compilation. How do i debug this? - - - - - 3 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - testsuite/tests/rebindable/T18324.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1055,11 +1055,12 @@ data HsExpansion orig expanded = HsExpanded orig expanded deriving Data --- | Just print the original expression (the @a@). +-- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - (ppr orig) + -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + -- (ppr orig) + = ppr orig <+> braces (text "Expansion:" <+> ppr expanded) {- @@ -1961,6 +1962,13 @@ matchDoContextErrString (MDoExpr m) = prependQualified m (text "'mdo' block") matchDoContextErrString ListComp = text "list comprehension" matchDoContextErrString MonadComp = text "monad comprehension" +instance Outputable HsDoFlavour where + ppr (DoExpr m) = text "DoExpr" <+> parens (ppr m) + ppr (MDoExpr m) = text "MDoExpr" <+> parens (ppr m) + ppr GhciStmtCtxt = text "GhciStmtCtxt" + ppr ListComp = text "ListComp" + ppr MonadComp = text "MonadComp" + pprMatchInCtxt :: (OutputableBndrId idR, Outputable body) => Match (GhcPass idR) body -> SDoc pprMatchInCtxt match = hang (text "In" <+> pprMatchContext (m_ctxt match) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -76,7 +76,7 @@ import qualified GHC.LanguageExtensions as LangExt import Language.Haskell.Syntax.Basic (FieldLabelString(..)) -import Data.List (unzip4, minimumBy) +import Data.List (unzip4, minimumBy, (\\)) import Data.List.NonEmpty ( NonEmpty(..), nonEmpty ) import Data.Maybe (isJust, isNothing) import Control.Arrow (first) @@ -432,12 +432,20 @@ rnExpr (HsDo _ do_or_lc (L l stmts)) = do { ((stmts1, _), fvs1) <- rnStmtsWithFreeVars (HsDoStmt do_or_lc) rnExpr stmts (\ _ -> return ((), emptyFVs)) - ; (pp_stmts, fvs2) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 + ; ((pp_stmts, fvs2), is_app_do) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 ; let orig_do_block = HsDo noExtField do_or_lc (L l pp_stmts) - expd_do_block = expand_do_stmts pp_stmts - ; return ( mkExpandedExpr orig_do_block expd_do_block - , fvs1 `plusFV` fvs2 ) } - + ; return $ case do_or_lc of + DoExpr {} -> (if is_app_do + -- TODO i don't want to thing about applicative stmt rearrangements yet + then orig_do_block + else let expd_do_block = expand_do_stmts do_or_lc pp_stmts + in mkExpandedExpr orig_do_block expd_do_block + , fvs1 `plusFV` fvs2 ) + _ -> (orig_do_block, fvs1 `plusFV` fvs2) + -- ListComp -> (orig_do_block, fvs1 `plusFV` fvs2) + -- MDoExpr {} -> (orig_do_block, fvs1 `plusFV` fvs2) -- TODO: Recursive mfix like do statements + -- GhciStmtCtxt -> (orig_do_block, fvs1 `plusFV` fvs2) + } -- ExplicitList: see Note [Handling overloaded and rebindable constructs] rnExpr (ExplicitList _ exps) = do { (exps', fvs) <- rnExprs exps @@ -1060,7 +1068,7 @@ rnStmts ctxt rnBody stmts thing_inside postProcessStmtsForApplicativeDo :: HsDoFlavour -> [(ExprLStmt GhcRn, FreeVars)] - -> RnM ([ExprLStmt GhcRn], FreeVars) + -> RnM (([ExprLStmt GhcRn], FreeVars), Bool) -- True <=> applicative do statement postProcessStmtsForApplicativeDo ctxt stmts = do { -- rearrange the statements using ApplicativeStmt if @@ -1074,8 +1082,10 @@ postProcessStmtsForApplicativeDo ctxt stmts ; in_th_bracket <- isBrackStage <$> getStage ; if ado_is_on && is_do_expr && not in_th_bracket then do { traceRn "ppsfa" (ppr stmts) - ; rearrangeForApplicativeDo ctxt stmts } - else noPostProcessStmts (HsDoStmt ctxt) stmts } + ; ado_stmts_and_fvs <- rearrangeForApplicativeDo ctxt stmts + ; return (ado_stmts_and_fvs, True) } + else do { do_stmts_and_fvs <- noPostProcessStmts (HsDoStmt ctxt) stmts + ; return (do_stmts_and_fvs, False) } } -- | strip the FreeVars annotations from statements noPostProcessStmts @@ -2711,50 +2721,107 @@ mkExpandedExpr a b = XExpr (HsExpanded a b) -- | Expand the Do statments so that it works fine with Quicklook -- See Note[Rebindable Do Expanding Statements] -- ANI Questions: 1. What should be the location information in the expanded expression? Currently the error is still displayed on the expanded expr and not on the unexpanded expr --- 2. Need to figure out the exact cases where this function needs to be called. It fails on lists +-- 2. Need to figure out the exact cases where this function needs to be called. It fails on lists -- 3. Convert let statements into expanded version. -- 4. hopefully the co-recursive cases won't get affected by this expansion -expand_do_stmts :: [ExprLStmt GhcRn] -> HsExpr GhcRn - -expand_do_stmts [L _ (LastStmt _ body _ NoSyntaxExprRn)] --- TODO: not sure about this maybe this never happens in a do block? --- This does happen in a list comprehension though --- = genHsApp (genHsVar returnMName) body - = unLoc body - -expand_do_stmts [L l (LastStmt _ body _ (SyntaxExprRn ret))] --- +expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> HsExpr GhcRn + +expand_do_stmts do_flavour [L _ (LastStmt _ body _ NoSyntaxExprRn)] + -- if it is a last statement of a list comprehension, we need to explicitly return it -- See Note [TODO] + -- genHsApp (genHsVar returnMName) body + | ListComp <- do_flavour + = genHsApp (genHsVar returnMName) body + | MonadComp <- do_flavour + = unLoc body -- genHsApp (genHsVar returnMName) body + | otherwise + -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt + = unLoc body + +expand_do_stmts _ [L l (LastStmt _ body _ (SyntaxExprRn ret))] +-- -- ------------------------------------------------ -- return e ~~> return e -- definitely works T18324.hs = unLoc $ mkHsApp (L l ret) body -expand_do_stmts ((L l (BindStmt _ x e)):lstmts) +expand_do_stmts do_or_lc ((L l (BindStmt _ x e)) : lstmts) = -- stmts ~~> stmt' -- ------------------------------------------------ --- x <- e ; stmts ~~> (Prelude.>>=) e (\ x -> stmts' ) - = genHsApps bindMName -- (>>=) - [ e -- e - , mkHsLam [x] (L l $ expand_do_stmts lstmts) -- (\ x -> stmts') +-- x <- e ; stmts ~~> (Prelude.>>=) e (\ x -> stmts') + genHsApps bindMName -- (Prelude.>>=) + [ e + , mkHsLam [x] (L l $ expand_do_stmts do_or_lc lstmts) -- (\ x -> stmts') ] --- expand_do_stmts ((L l (LetStmt _ x e)):lstmts) = undefined + +expand_do_stmts do_or_lc (L l (LetStmt _ bnds) : lstmts) = -- stmts ~~> stmts' -- ------------------------------------------------ -- let x = e ; stmts ~~> let x = e in stmts' + HsLet NoExtField noHsTok bnds noHsTok + $ L l (expand_do_stmts do_or_lc lstmts) + -expand_do_stmts ((L l (BodyStmt _ e (SyntaxExprRn f) _)):lstmts) +expand_do_stmts do_or_lc ((L l (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- stmts ~~> stmts' -- ---------------------------------------------- --- e ; stmts ~~> (Prelude.>>) e (\ _ -> stmt') - = unLoc $ nlHsApp (nlHsApp (L l f) -- (>>) See Note [BodyStmt] +-- e ; stmts ~~> (Prelude.>>) e stmt' + unLoc $ nlHsApp (nlHsApp (L l f) -- (>>) See Note [BodyStmt] e) - $ mkHsLam [] (L l $ expand_do_stmts lstmts) + $ (L l $ expand_do_stmts do_or_lc lstmts) + +expand_do_stmts do_or_lc ((L l (RecStmt { recS_stmts = rec_stmts + , recS_later_ids = later_ids -- forward referenced local ids + , recS_rec_ids = local_ids -- ids referenced outside of the rec block + , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr + , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr + -- use it at the end of expanded rec block + })) + : lstmts) = +-- See Note [Typing a RecStmt] +-- stmts ~~> stmts' +-- ------------------------------------------------------------------------------------------- +-- rec { later_ids, local_ids, rec_block } ; stmts +-- ~~> ((Prelude.>>=) (mfix (\[ local_ids ++ later_ids ] +-- -> do { rec_stmts +-- ; return (later_ids, local_ids) } ))) +-- (\ [ local_ids ++ later_ids ] -> stmts') --- expand_do_stmts ((L l (TransStmt {})):lstmts) = undefined --- expand_do_stmts ((L l (RecStmt {})):lstmts) = undefined + genHsApps bindMName -- (Prelude.>>=) + [ mkHsApp (noLocA mfix_fun) mfix_expr -- mfix (do block) + , mkHsLam [ mkBigLHsVarPatTup $ all_ids ] + (L l $ expand_do_stmts do_or_lc lstmts) -- (\ x -> stmts') + ] + where + local_only_ids = local_ids \\ later_ids -- get unique local rec ids; local rec ids and later ids can overlap + all_ids = local_only_ids ++ later_ids -- put local ids before return ids + + return_stmt :: ExprLStmt GhcRn + return_stmt = noLocA $ LastStmt noExtField + (mkHsApp (noLocA return_fun) + $ mkBigLHsTup (map nlHsVar all_ids) noExtField) + Nothing + (SyntaxExprRn return_fun) + do_stmts :: XRec GhcRn [ExprLStmt GhcRn] + do_stmts = noLocA $ (unLoc rec_stmts) ++ [return_stmt] + do_block :: LHsExpr GhcRn + do_block = L l $ HsDo noExtField (MDoExpr Nothing) $ do_stmts + mfix_expr :: LHsExpr GhcRn + mfix_expr = mkHsLam [ mkBigLHsVarPatTup all_ids ] $ do_block + +expand_do_stmts _ (stmt@(L _ (RecStmt {})):_) = + pprPanic "expand_do_stmts: impossible happened RecStmt" $ ppr stmt + + +expand_do_stmts _ (stmt@(L _ (TransStmt {})):_) = + pprPanic "expand_do_stmts: impossible happened TransStmt" $ ppr stmt + +expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = + pprPanic "expand_do_stmts: impossible happened ParStmt" $ ppr stmt + +expand_do_stmts _ (stmt@(L _ (ApplicativeStmt {})):_) = + pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" $ ppr stmt --- expand_do_stmts (stmt@(L _ (ParStmt {})):_) = pprPanic "expand_do_stmts: impossible happened" $ ppr stmt -expand_do_stmts stmt = pprPanic "expand_do_stmts: impossible happened" $ ppr stmt +expand_do_stmts do_flavor stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr do_flavor $$ ppr stmts) ----------------------------------------- -- Bits and pieces for RecordDotSyntax. ===================================== testsuite/tests/rebindable/T18324.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE ImpredicativeTypes, DeriveAnyClass #-} +{-# LANGUAGE ImpredicativeTypes, DeriveAnyClass, MonadComprehensions #-} module T18324 where @@ -26,3 +26,9 @@ foo2 = do { x <- t ; return (p x) } -- foo3 = do { x <- ts ; update ts ; return (p x) } +partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a]) +partitionM _ [] = pure ([], []) +partitionM f (x:xs) = do + res <- f x + (as,bs) <- partitionM f xs + pure ([x | res]++as, [x | not res]++bs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5af2773cc5a5c6763037c47050c4b9ee2a93015a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5af2773cc5a5c6763037c47050c4b9ee2a93015a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 22:14:16 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 15 Mar 2023 18:14:16 -0400 Subject: [Git][ghc/ghc][wip/T23051] Wibble Message-ID: <641243382db7b_37e76b287afb34363620@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23051 at Glasgow Haskell Compiler / GHC Commits: c2817f5a by Simon Peyton Jones at 2023-03-15T22:15:51+00:00 Wibble - - - - - 1 changed file: - compiler/GHC/Tc/Utils/TcMType.hs Changes: ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1444,13 +1444,16 @@ collect_cand_qtvs orig_ty is_dep cur_lvl bound dvs ty -- See Note [Use level numbers for quantification] | case tcTyVarDetails tv of - SkolemTv {} -> True -- lvl > pushTcLevel cur_lvl - _ -> False + SkolemTv _ lvl _ -> lvl > pushTcLevel cur_lvl + _ -> False = return dv -- Skip inner skolems -- This only happens for erroneous program with bad telescopes -- e.g. BadTelescope2: forall a k (b :: k). SameKind a b -- We have (a::k), and at the outer we don't want to quantify -- over the already-quantified skolem k. + -- (Apparently we /do/ want to quantify over skolems whose level sk_lvl is + -- sk_lvl > cur_lvl, but we definitely do; you get lots of failures otherwise. + -- A battle for another day.) | tv `elemDVarSet` kvs = return dv -- We have met this tyvar already View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2817f5a630dfb10a5352c40a2da3beef218eddd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2817f5a630dfb10a5352c40a2da3beef218eddd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 22:16:38 2023 From: gitlab at gitlab.haskell.org (Ziyang Liu (@zliu41)) Date: Wed, 15 Mar 2023 18:16:38 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/zliu41/spec/patch/925 Message-ID: <641243c6eb710_37e76b289691dc36748c@gitlab.mail> Ziyang Liu pushed new branch wip/zliu41/spec/patch/925 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/zliu41/spec/patch/925 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 15 23:20:52 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 15 Mar 2023 19:20:52 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] More wibbles Message-ID: <641252d4c96e6_37e76b29ab118837153d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 440df186 by Simon Peyton Jones at 2023-03-15T23:22:23+00:00 More wibbles - - - - - 19 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/indexed-types/should_fail/T8518.stderr - testsuite/tests/partial-sigs/should_compile/T10403.stderr - testsuite/tests/partial-sigs/should_fail/T14584.stderr - testsuite/tests/polykinds/T14939.hs - − testsuite/tests/polykinds/T18451a.stderr - testsuite/tests/rep-poly/T13929.stderr - testsuite/tests/typecheck/should_compile/PolytypeDecomp.stderr - testsuite/tests/typecheck/should_compile/T13651.stderr - testsuite/tests/typecheck/should_fail/T16512a.stderr - testsuite/tests/typecheck/should_fail/T7869.stderr Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -596,9 +596,9 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co) -- a DFunUnfolding in mk_worker_unfolding , not (exprIsTrivial rhs) -- Not x = y |> co; Wrinkle 1 , not (hasInlineUnfolding info) -- Not INLINE things: Wrinkle 4 - , isConcrete (typeKind work_ty) -- Don't peel off a cast if doing so would - -- lose the underlying runtime representation. - -- See Note [Preserve RuntimeRep info in cast w/w] + , isConcreteType (typeKind work_ty) -- Don't peel off a cast if doing so would + -- lose the underlying runtime representation. + -- See Note [Preserve RuntimeRep info in cast w/w] , not (isOpaquePragma (idInlinePragma old_bndr)) -- Not for OPAQUE bindings -- See Note [OPAQUE pragma] = do { uniq <- getUniqueM ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -233,7 +233,7 @@ module GHC.Core.Type ( -- * Kinds isTYPEorCONSTRAINT, - isConcrete, isFixedRuntimeRepKind, + isConcreteType, isFixedRuntimeRepKind, ) where import GHC.Prelude @@ -2755,28 +2755,26 @@ argsHaveFixedRuntimeRep ty (bndrs, _) = splitPiTys ty -- | Checks that a kind of the form 'Type', 'Constraint' --- or @'TYPE r@ is concrete. See 'isConcrete'. +-- or @'TYPE r@ is concrete. See 'isConcreteType'. -- -- __Precondition:__ The type has kind `TYPE blah` or `CONSTRAINT blah` isFixedRuntimeRepKind :: HasDebugCallStack => Kind -> Bool isFixedRuntimeRepKind k = assertPpr (isTYPEorCONSTRAINT k) (ppr k) $ -- the isLiftedTypeKind check is necessary b/c of Constraint - isConcrete k + isConcreteType k -- | Tests whether the given type is concrete, i.e. it -- whether it consists only of concrete type constructors, -- concrete type variables, and applications. -- -- See Note [Concrete types] in GHC.Tc.Utils.Concrete. -isConcrete :: Type -> Bool -isConcrete = go +isConcreteType :: Type -> Bool +isConcreteType = go where go (TyVarTy tv) = isConcreteTyVar tv go (AppTy ty1 ty2) = go ty1 && go ty2 - go (TyConApp tc tys) -- Works for synonyms too - | isConcreteTyCon tc = all go tys - | otherwise = False + go (TyConApp tc tys) = go_tc tc tys go ForAllTy{} = False go (FunTy _ w t1 t2) = go w && go (typeKind t1) && go t1 @@ -2785,6 +2783,21 @@ isConcrete = go go CastTy{} = False go CoercionTy{} = False + go_tc tc tys + | isForgetfulSynTyCon tc -- E.g. type S a = Int + -- Then (S x) is concrete even if x isn't + , Just ty' <- expandSynTyConApp_maybe tc tys + = go ty' + + -- Apart from forgetful synonyms, isConcreteTyCon + -- is enough; no need to expand. This is good for e.g + -- type LiftedRep = BoxedRep Lifted + | isConcreteTyCon tc + = all go tys + + | otherwise -- E.g. type families + = False + {- %************************************************************************ ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1537,13 +1537,9 @@ any more. So we don't assert that it is. -- Don't have multiple equality errors from the same location -- E.g. (Int,Bool) ~ (Bool,Int) one error will do! mkEqErr :: SolverReportErrCtxt -> NonEmpty ErrorItem -> TcM SolverReport -mkEqErr ctxt items@(item:|_) - | item:_ <- filter (not . ei_suppress) (toList items) - = mkEqErr1 ctxt item - - | otherwise -- they're all suppressed. still need an error message - -- for -fdefer-type-errors though - = mkEqErr1 ctxt item +mkEqErr ctxt items + | item1 :| _ <- tryFilter (not . ei_suppress) items + = mkEqErr1 ctxt item1 mkEqErr1 :: SolverReportErrCtxt -> ErrorItem -> TcM SolverReport mkEqErr1 ctxt item -- Wanted only @@ -1609,9 +1605,8 @@ mkEqErr_help ctxt item ty1 ty2 | Just casted_tv2 <- getCastedTyVar_maybe ty2 = mkTyVarEqErr ctxt item casted_tv2 ty1 | otherwise - = do - err <- reportEqErr ctxt item ty1 ty2 - return (err, noHints) + = do { err <- reportEqErr ctxt item ty1 ty2 + ; return (err, noHints) } reportEqErr :: SolverReportErrCtxt -> ErrorItem @@ -1658,8 +1653,8 @@ mkTyVarEqErr' ctxt item (tv1, co1) ty2 (_, infos) <- zonkTidyFRRInfos (cec_tidy ctxt) [frr_info] return (FixedRuntimeRepError infos, []) - -- Impredicativity is a simple error to understand; try it before - -- anything more complicated. + -- Impredicativity is a simple error to understand; + -- try it before anything more complicated. | check_eq_result `cterHasProblem` cteImpredicative = do tyvar_eq_info <- extraTyVarEqInfo (tv1, Nothing) ty2 @@ -1679,6 +1674,12 @@ mkTyVarEqErr' ctxt item (tv1, co1) ty2 -- to be helpful since this is just an unimplemented feature. return (main_msg, []) + -- Incompatible kinds + -- This is wrinkle (4) in Note [Equalities with incompatible kinds] in + -- GHC.Tc.Solver.Canonical + | hasCoercionHoleCo co1 || hasCoercionHoleTy ty2 + = return (mkBlockedEqErr item, []) + | isSkolemTyVar tv1 -- ty2 won't be a meta-tyvar; we would have -- swapped in Solver.Canonical.canEqTyVarHomo || isTyVarTyVar tv1 && not (isTyVarTy ty2) @@ -1718,11 +1719,6 @@ mkTyVarEqErr' ctxt item (tv1, co1) ty2 in return (main_msg, []) - -- This is wrinkle (4) in Note [Equalities with incompatible kinds] in - -- GHC.Tc.Solver.Canonical - | hasCoercionHoleCo co1 || hasCoercionHoleTy ty2 - = return (mkBlockedEqErr item, []) - -- If the immediately-enclosing implication has 'tv' a skolem, and -- we know by now its an InferSkol kind of skolem, then presumably -- it started life as a TyVarTv, else it'd have been unified, given @@ -1786,7 +1782,7 @@ mkTyVarEqErr' ctxt item (tv1, co1) ty2 -- there is an error is not sufficient. See #21430. mb_concrete_reason | Just frr_orig <- isConcreteTyVar_maybe tv1 - , not (isConcrete ty2) + , not (isConcreteType ty2) = Just $ frr_reason frr_orig tv1 ty2 | Just (tv2, frr_orig) <- isConcreteTyVarTy_maybe ty2 , not (isConcreteTyVar tv1) ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -2844,7 +2844,7 @@ pprTcSolverReportMsg _ (FixedRuntimeRepError frr_origs) = CastTy inner_ty _ -- A confusing cast is one that is responsible -- for a representation-polymorphism error. - -> isConcrete (typeKind inner_ty) + -> isConcreteType (typeKind inner_ty) _ -> False type_printout :: Type -> SDoc ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1807,10 +1807,18 @@ swapAndFinish ev eq_rel swapped lhs_tv can_rhs tryIrredInstead :: CheckTyEqResult -> CtEvidence -> EqRel -> SwapFlag -> CanEqLHS -> TcType -> TcS (StopOrContinue Ct) -- We have a non-canonical equality --- No need to swap; just hand it off -tryIrredInstead reason ev _eq_rel _swapped lhs rhs +-- We still swap it 'swapped' sayso, so that it is oriented +-- in the direction that the error message reporting machinery +-- expects it; e.g. (m ~ t m) rather than (t m ~ m) +-- This is not very important, and only affects error reporting. +tryIrredInstead reason ev eq_rel swapped lhs rhs = do { traceTcS "cantMakeCanonical" (ppr reason $$ ppr lhs $$ ppr rhs) - ; solveIrredEquality (NonCanonicalReason reason) ev } + ; new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped + (mkReflRedn role (canEqLHSType lhs)) + (mkReflRedn role rhs) + ; solveIrredEquality (NonCanonicalReason reason) new_ev } + where + role = eqRelRole eq_rel ----------------------- -- | Solve a reflexive equality constraint ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1224,11 +1224,11 @@ nonDefaultableTyVarsOfWC (WC { wc_simple = simples, wc_impl = implics, wc_errors EqPred NomEq lhs rhs | Just tv <- getTyVar_maybe lhs , isConcreteTyVar tv - , not (isConcrete rhs) + , not (isConcreteType rhs) -> unitVarSet tv | Just tv <- getTyVar_maybe rhs , isConcreteTyVar tv - , not (isConcrete lhs) + , not (isConcreteType lhs) -> unitVarSet tv _ -> emptyVarSet ===================================== compiler/GHC/Tc/Utils/Concrete.hs ===================================== @@ -22,7 +22,7 @@ import GHC.Core.Coercion ( coToMCo, mkCastTyMCo , mkGReflRightMCo, mkNomReflCo ) import GHC.Core.TyCo.Rep ( Type(..), MCoercion(..) ) import GHC.Core.TyCon ( isConcreteTyCon ) -import GHC.Core.Type ( isConcrete, typeKind, tyVarKind, coreView +import GHC.Core.Type ( isConcreteType, typeKind, tyVarKind, coreView , mkTyVarTy, mkTyConApp, mkFunTy, mkAppTy ) import GHC.Tc.Types ( TcM, ThStage(..), PendingStuff(..) ) @@ -83,7 +83,7 @@ as a central point of reference for this topic. Note [The Concrete mechanism] Instead of simply checking that a type `ty` is concrete (i.e. computing - 'isConcrete`), we emit an equality constraint: + 'isConcreteType`), we emit an equality constraint: co :: ty ~# concrete_ty @@ -179,7 +179,7 @@ Definition: a type is /concrete/ iff it is: - a concrete type constructor (as defined below), or - a concrete type variable (see Note [ConcreteTv] below), or - an application of a concrete type to another concrete type -GHC.Core.Type.isConcrete checks whether a type meets this definition. +GHC.Core.Type.isConcreteType checks whether a type meets this definition. Definition: a /concrete type constructor/ is defined by - a promoted data constructor @@ -634,7 +634,7 @@ makeTypeConcrete conc_orig ty = go ty | Just ty <- coreView ty = go ty - | isConcrete ty + | isConcreteType ty = pure ty go ty@(TyVarTy tv) -- not a ConcreteTv (already handled above) = do { mb_filled <- lift $ isFilledMetaTyVar_maybe tv ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -843,7 +843,7 @@ cloneTyVarTyVar name kind -- This is checked with an assertion. newConcreteTyVar :: HasDebugCallStack => ConcreteTvOrigin -> TcKind -> TcM TcTyVar newConcreteTyVar reason kind = - assertPpr (isConcrete kind) + assertPpr (isConcreteType kind) (text "newConcreteTyVar: non-concrete kind" <+> ppr kind) $ newAnonMetaTyVar (ConcreteTv reason) kind ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2538,7 +2538,7 @@ uTypeCheckTouchableTyVarEq lhs_tv rhs return (PuOK (reductionReducedType redn) emptyBag) } where flags | MetaTv { mtv_info = tv_info, mtv_tclvl = tv_lvl } <- tcTyVarDetails lhs_tv - = TEF { tef_foralls = False + = TEF { tef_foralls = isRuntimeUnkSkol lhs_tv , tef_fam_app = TEFA_Fail , tef_unifying = Unifying tv_info tv_lvl LC_None , tef_lhs = TyVarLHS lhs_tv ===================================== testsuite/tests/indexed-types/should_fail/T8518.stderr ===================================== @@ -18,8 +18,8 @@ T8518.hs:14:18: error: [GHC-83865] callCont :: c -> Z c -> B c -> Maybe (F c) (bound at T8518.hs:14:1) T8518.hs:17:9: error: [GHC-83865] - • Couldn't match type: F t2 - with: Z t2 -> B t2 -> F t2 + • Couldn't match type: Z t2 -> B t2 -> F t2 + with: F t2 Expected: t1 -> t2 -> F t2 Actual: t1 -> t2 -> Z t2 -> B t2 -> F t2 • In an equation for ‘callCont’: ===================================== testsuite/tests/partial-sigs/should_compile/T10403.stderr ===================================== @@ -15,39 +15,22 @@ T10403.hs:16:12: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)] T10403.hs:20:7: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ - standing for ‘(a1 -> a2) -> f0 a1 -> H f0’ - Where: ‘f0’ is an ambiguous type variable + standing for ‘(a1 -> a2) -> B t0 a1 -> H (B t0)’ + Where: ‘t0’ is an ambiguous type variable ‘a2’, ‘a1’ are rigid type variables bound by - the inferred type of h2 :: (a1 -> a2) -> f0 a1 -> H f0 + the inferred type of h2 :: (a1 -> a2) -> B t0 a1 -> H (B t0) at T10403.hs:23:1-41 • In the type signature: h2 :: _ -T10403.hs:23:15: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] - • Ambiguous type variable ‘f0’ arising from a use of ‘fmap’ - prevents the constraint ‘(Functor f0)’ from being solved. - Relevant bindings include - b :: f0 a1 (bound at T10403.hs:23:6) - h2 :: (a1 -> a2) -> f0 a1 -> H f0 (bound at T10403.hs:23:1) - Probable fix: use a type annotation to specify what ‘f0’ should be. - Potentially matching instances: - instance Functor IO -- Defined in ‘GHC.Base’ - instance Functor (B t) -- Defined at T10403.hs:11:10 - ...plus 8 others - ...plus one instance involving out-of-scope types - (use -fprint-potential-instances to see them all) - • In the second argument of ‘(.)’, namely ‘fmap (const ())’ - In the expression: (H . fmap (const ())) (fmap f b) - In an equation for ‘h2’: h2 f b = (H . fmap (const ())) (fmap f b) - T10403.hs:29:8: warning: [GHC-46956] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘f0’ with ‘B t’ + • Couldn't match type ‘t0’ with ‘t’ Expected: H (B t) - Actual: H f0 - • because type variable ‘t’ would escape its scope - This (rigid, skolem) type variable is bound by - the type signature for: - app2 :: forall t. H (B t) - at T10403.hs:28:1-15 + Actual: H (B t0) + because type variable ‘t’ would escape its scope + This (rigid, skolem) type variable is bound by + the type signature for: + app2 :: forall t. H (B t) + at T10403.hs:28:1-15 • In the expression: h2 (H . I) (B ()) In an equation for ‘app2’: app2 = h2 (H . I) (B ()) • Relevant bindings include ===================================== testsuite/tests/partial-sigs/should_fail/T14584.stderr ===================================== @@ -11,7 +11,7 @@ T14584.hs:57:41: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] act @_ @_ @act (fromSing @m (sing @m @a :: Sing _)) T14584.hs:57:41: warning: [GHC-06200] [-Wdeferred-type-errors (in -Wdefault)] - • Cannot use equality for substitution: a0 ~ a + • Cannot use equality for substitution: a ~ a0 Doing so would be ill-kinded. • In the second argument of ‘fromSing’, namely ‘(sing @m @a :: Sing _)’ ===================================== testsuite/tests/polykinds/T14939.hs ===================================== @@ -12,8 +12,10 @@ newtype Frí (cls::Type -> Constraint) :: (Type -> Alg cls Type) where Frí :: { with :: forall x. cls x => (a -> x) -> x } -> Frí cls a +{- data AlgCat (cls::Type -> Constraint) :: Cat (Alg cls Type) where AlgCat :: (cls a, cls b) => (a -> b) -> AlgCat cls a b leftAdj :: AlgCat cls (Frí cls a) b -> (a -> b) -leftAdj (AlgCat f) a = undefined \ No newline at end of file +leftAdj (AlgCat f) a = undefined +-} \ No newline at end of file ===================================== testsuite/tests/polykinds/T18451a.stderr deleted ===================================== @@ -1,7 +0,0 @@ - -T18451a.hs:11:15: error: [GHC-97739] - • These kind and type variables: a b (c :: Const Type b) - are out of dependency order. Perhaps try this ordering: - (b :: k) (a :: Const (*) b) (c :: Const (*) b) - • In the type signature: - foo :: forall a b (c :: Const Type b). Proxy '[a, c] ===================================== testsuite/tests/rep-poly/T13929.stderr ===================================== @@ -3,7 +3,7 @@ T13929.hs:29:24: error: [GHC-55287] • The tuple argument in first position does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 + GUnboxed f LiftedRep :: TYPE c0 Cannot unify ‘rf’ with the type variable ‘c0’ because it is not a concrete ‘RuntimeRep’. • In the expression: (# gunbox x, gunbox y #) @@ -12,6 +12,7 @@ T13929.hs:29:24: error: [GHC-55287] In the instance declaration for ‘GUnbox (f :*: g) (TupleRep [rf, rg])’ • Relevant bindings include + x :: f p (bound at T13929.hs:29:13) gunbox :: (:*:) f g p -> GUnboxed (f :*: g) (TupleRep [rf, rg]) (bound at T13929.hs:29:5) ===================================== testsuite/tests/typecheck/should_compile/PolytypeDecomp.stderr ===================================== @@ -8,13 +8,3 @@ PolytypeDecomp.hs:30:17: error: [GHC-91028] • In the expression: x In the first argument of ‘myLength’, namely ‘[x, f]’ In the expression: myLength [x, f] - -PolytypeDecomp.hs:30:19: error: [GHC-91028] - • Couldn't match type ‘a0’ with ‘[forall a. Maybe a]’ - Expected: Id a0 - Actual: [forall a. F [a]] - Cannot instantiate unification variable ‘a0’ - with a type involving polytypes: [forall a. Maybe a] - • In the expression: f - In the first argument of ‘myLength’, namely ‘[x, f]’ - In the expression: myLength [x, f] ===================================== testsuite/tests/typecheck/should_compile/T13651.stderr ===================================== @@ -1,6 +1,6 @@ T13651.hs:12:8: error: [GHC-25897] - • Could not deduce ‘cs ~ Bar (Foo h) (Foo s)’ + • Could not deduce ‘cr ~ Bar h (Foo r)’ from the context: (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) bound by the type signature for: @@ -8,7 +8,7 @@ T13651.hs:12:8: error: [GHC-25897] (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) => Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs) at T13651.hs:(12,8)-(14,65) - ‘cs’ is a rigid type variable bound by + ‘cr’ is a rigid type variable bound by the type signature for: foo :: forall cr cu h r u cs s. (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) => ===================================== testsuite/tests/typecheck/should_fail/T16512a.stderr ===================================== @@ -1,20 +1,18 @@ T16512a.hs:41:25: error: [GHC-25897] - • Couldn't match type ‘as’ with ‘a : as’ + • Couldn't match type ‘b’ with ‘a -> b’ Expected: AST (ListVariadic (a : as) b) Actual: AST (ListVariadic as (a -> b)) - ‘as’ is a rigid type variable bound by - a pattern with constructor: - AnApplication :: forall (as :: [*]) b. - AST (ListVariadic as b) -> ASTs as -> AnApplication b, - in a case alternative - at T16512a.hs:40:9-26 + ‘b’ is a rigid type variable bound by + the type signature for: + unapply :: forall b. AST b -> AnApplication b + at T16512a.hs:37:1-35 • In the first argument of ‘AnApplication’, namely ‘g’ In the expression: AnApplication g (a `ConsAST` as) In a case alternative: AnApplication g as -> AnApplication g (a `ConsAST` as) • Relevant bindings include - as :: ASTs as (bound at T16512a.hs:40:25) g :: AST (ListVariadic as (a -> b)) (bound at T16512a.hs:40:23) a :: AST a (bound at T16512a.hs:38:15) f :: AST (a -> b) (bound at T16512a.hs:38:10) + unapply :: AST b -> AnApplication b (bound at T16512a.hs:38:1) ===================================== testsuite/tests/typecheck/should_fail/T7869.stderr ===================================== @@ -1,18 +1,16 @@ T7869.hs:3:12: error: [GHC-25897] - • Couldn't match type ‘a1’ with ‘a’ + • Couldn't match type ‘b1’ with ‘b’ Expected: [a1] -> b1 Actual: [a] -> b - ‘a1’ is a rigid type variable bound by + ‘b1’ is a rigid type variable bound by an expression type signature: forall a1 b1. [a1] -> b1 at T7869.hs:3:20-27 - ‘a’ is a rigid type variable bound by + ‘b’ is a rigid type variable bound by the inferred type of f :: [a] -> b at T7869.hs:3:1-27 • In the expression: f x In the expression: (\ x -> f x) :: [a] -> b In an equation for ‘f’: f = (\ x -> f x) :: [a] -> b - • Relevant bindings include - x :: [a1] (bound at T7869.hs:3:7) - f :: [a] -> b (bound at T7869.hs:3:1) + • Relevant bindings include f :: [a] -> b (bound at T7869.hs:3:1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/440df186631c058618eb46b4d2e36540e5b7291c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/440df186631c058618eb46b4d2e36540e5b7291c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 00:51:53 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 15 Mar 2023 20:51:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ioref-swap-xchg Message-ID: <6412682951450_37e76b2b4dadc03790ed@gitlab.mail> Ben Gamari pushed new branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ioref-swap-xchg You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 00:55:38 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 15 Mar 2023 20:55:38 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] testsuite: Add test for atomicSwapIORef# Message-ID: <6412690a241a2_37e76b2b4dadfc3811b4@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: e4a03ad6 by Ben Gamari at 2023-03-15T20:55:24-04:00 testsuite: Add test for atomicSwapIORef# - - - - - 2 changed files: - + libraries/base/tests/AtomicSwapIORef.hs - libraries/base/tests/all.T Changes: ===================================== libraries/base/tests/AtomicSwapIORef.hs ===================================== @@ -0,0 +1,7 @@ +import Data.IORef + +main :: IO () +main = do + r <- newIORef 42 :: IO Int + atomicSwapIORef r 43 + readIORef r >>= print ===================================== libraries/base/tests/all.T ===================================== @@ -297,3 +297,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('AtomicSwapIORef', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4a03ad6c01b5ec82075d0cb58ff8dda7906fe7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4a03ad6c01b5ec82075d0cb58ff8dda7906fe7b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 02:50:26 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 15 Mar 2023 22:50:26 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 2 commits: compiler: Implement atomicSwapIORef with xchg Message-ID: <641283f2ea35e_37e76b2d3eb3e03897c9@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: 8b1fca93 by Ben Gamari at 2023-03-15T22:50:16-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - 2d8c42f9 by Ben Gamari at 2023-03-15T22:50:17-04:00 testsuite: Add test for atomicSwapIORef# - - - - - 8 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/GHC/IORef.hs - + libraries/base/tests/AtomicSwapIORef.hs - libraries/base/tests/all.T - rts/PrimOps.cmm - rts/include/Cmm.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2464,6 +2464,13 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp + MutVar# s v -> v -> State# s -> State# s + {Atomically exchange the value of a 'MutVar#'.} + with + out_of_line = True + has_side_effects = True + -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1559,6 +1559,7 @@ emitPrimOp cfg primop = ResizeMutableByteArrayOp_Char -> alwaysExternal ShrinkSmallMutableArrayOp_Char -> alwaysExternal NewMutVarOp -> alwaysExternal + AtomicSwapMutVarOp -> alwaysExternal AtomicModifyMutVar2Op -> alwaysExternal AtomicModifyMutVar_Op -> alwaysExternal CasMutVarOp -> alwaysExternal ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -859,6 +859,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[status,r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -127,10 +127,9 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a --- Bad implementation! This will be a primop shortly. atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicModifyMutVar2# ref (\_old -> Box new) s of - (# s', old, Box _new #) -> (# s', old #) + case atomicSwapIORef# ref new s of + (# s', old #) -> (# s', old #) data Box a = Box a ===================================== libraries/base/tests/AtomicSwapIORef.hs ===================================== @@ -0,0 +1,7 @@ +import Data.IORef + +main :: IO () +main = do + r <- newIORef 42 :: IO Int + atomicSwapIORef r 43 + readIORef r >>= print ===================================== libraries/base/tests/all.T ===================================== @@ -297,3 +297,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('AtomicSwapIORef', normal, compile_and_run, ['']) ===================================== rts/PrimOps.cmm ===================================== @@ -689,6 +689,14 @@ stg_newMutVarzh ( gcptr init ) return (mv); } +stg_swapMutVarzh ( gcptr mv, gcptr old ) + /* MutVar# s a -> a -> State# s -> (# State#, a #) */ +{ + W_ new; + (new) = prim %xchgW(mv+OFFSET_StgMutVar_var, old); + return (new); +} + // RRN: To support the "ticketed" approach, we return the NEW rather // than old value if the CAS is successful. This is received in an // opaque form in the Haskell code, preventing the compiler from ===================================== rts/include/Cmm.h ===================================== @@ -193,8 +193,10 @@ #if SIZEOF_W == 4 #define cmpxchgW cmpxchg32 +#define xchgW xchg32 #elif SIZEOF_W == 8 #define cmpxchgW cmpxchg64 +#define xchgW xchg64 #endif /* ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4a03ad6c01b5ec82075d0cb58ff8dda7906fe7b...2d8c42f9531e51ab7a04236bf550bcc763e28b05 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4a03ad6c01b5ec82075d0cb58ff8dda7906fe7b...2d8c42f9531e51ab7a04236bf550bcc763e28b05 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 10:52:12 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 16 Mar 2023 06:52:12 -0400 Subject: [Git][ghc/ghc][wip/interface-loading-errs] 2 commits: refactor interface error datatypes Message-ID: <6412f4dcd6e10_37e76b34c2615c4375ae@gitlab.mail> Matthew Pickering pushed to branch wip/interface-loading-errs at Glasgow Haskell Compiler / GHC Commits: e873efca by sheaf at 2023-03-16T10:39:02+00:00 refactor interface error datatypes - - - - - abac1c81 by Matthew Pickering at 2023-03-16T10:51:21+00:00 Fix test - - - - - 17 changed files: - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Tidy.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error/Codes.hs - ghc/Main.hs Changes: ===================================== compiler/GHC/Driver/Config/Diagnostic.hs ===================================== @@ -49,8 +49,9 @@ initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage initPsMessageOpts _ = NoDiagnosticOpts initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage -initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags - , tcOptsShowTriedFiles = verbosity dflags >= 3 } +initTcMessageOpts dflags = + TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags + , tcOptsShowTriedFiles = verbosity dflags >= 3 } initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage initDsMessageOpts _ = NoDiagnosticOpts ===================================== compiler/GHC/Driver/Config/Tidy.hs ===================================== @@ -28,7 +28,6 @@ import GHC.Platform.Ways import qualified GHC.LanguageExtensions as LangExt import GHC.Types.Error import GHC.Utils.Error -import GHC.Tc.Errors.Types (TcRnMessage(..)) import GHC.Driver.Config.Diagnostic (initTcMessageOpts) initTidyOpts :: HscEnv -> IO TidyOpts @@ -56,11 +55,10 @@ initStaticPtrOpts hsc_env = do let lookupM n = lookupGlobal_maybe hsc_env n >>= \case Succeeded r -> pure r Failed err -> - let txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError err) + let txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) err in pprPanic "initStaticPtrOpts: couldn't find" (ppr (txt, n)) - mk_string <- getMkStringIds (fmap tyThingId . lookupM) static_ptr_info_datacon <- tyThingDataCon <$> lookupM staticPtrInfoDataConName static_ptr_datacon <- tyThingDataCon <$> lookupM staticPtrDataConName ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -16,7 +16,7 @@ import GHC.Driver.Flags import GHC.Driver.Session import GHC.HsToCore.Errors.Ppr () import GHC.Parser.Errors.Ppr () -import GHC.Tc.Errors.Ppr (missingInterfaceErrorHints, missingInterfaceErrorReason, missingInterfaceErrorDiagnostic) +import GHC.Tc.Errors.Ppr import GHC.Types.Error import GHC.Types.Error.Codes ( constructorCode ) import GHC.Unit.Types ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -16,28 +16,26 @@ import GHC.Driver.Env import GHC.Driver.Errors.Types import GHC.Data.Maybe import GHC.Prelude +import GHC.Tc.Errors.Types import GHC.Unit import GHC.Unit.Env import GHC.Unit.Finder.Types import GHC.Utils.Outputable as Outputable -import GHC.Tc.Errors.Types (MissingInterfaceError (..), CantFindInstalled(..), CantFindInstalledReason(..), CantFindWhat(..), BuildingCabalPackage) +-- ----------------------------------------------------------------------------- +-- Error messages badIfaceFile :: String -> SDoc -> SDoc badIfaceFile file err = vcat [text "Bad interface file:" <+> text file, nest 4 err] - - - --- ----------------------------------------------------------------------------- --- Error messages - -cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile -> ModuleName -> InstalledFindResult -> MissingInterfaceError -cannotFindInterface us mhu p mn ifr = CantFindInstalledErr (cantFindInstalledErr CantLoadInterface - AmbiguousInterface us mhu p mn ifr) - +cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile + -> ModuleName -> InstalledFindResult -> MissingInterfaceError +cannotFindInterface us mhu p mn ifr = + CantFindInstalledErr $ + cantFindInstalledErr CantLoadInterface + AmbiguousInterface us mhu p mn ifr cantFindInstalledErr :: CantFindWhat @@ -96,11 +94,13 @@ cannotFindModule hsc_env = cannotFindModule' (targetProfile (hsc_dflags hsc_env)) -cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> MissingInterfaceError -cannotFindModule' dflags unit_env profile mod res = CantFindErr (ue_units unit_env) $ +cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult + -> MissingInterfaceError +cannotFindModule' dflags unit_env profile mod res = + CantFindErr (ue_units unit_env) $ cantFindErr (checkBuildingCabalPackage dflags) cannotFindMsg - AmbigiousModule + AmbiguousModule unit_env profile mod @@ -125,15 +125,7 @@ cantFindErr -> FindResult -> CantFindInstalled cantFindErr _ _ multiple_found _ _ mod_name (FoundMultiple mods) - | Just pkgs <- unambiguousPackages - = CantFindInstalled mod_name multiple_found (MultiplePackages pkgs) - | otherwise - = CantFindInstalled mod_name multiple_found (MultiplePackages2 mods) - where - unambiguousPackages = foldl' unambiguousPackage (Just []) mods - unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) - = Just (moduleUnit m : xs) - unambiguousPackage _ _ = Nothing + = CantFindInstalled mod_name multiple_found (MultiplePackages mods) cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result = CantFindInstalled mod_name cannot_find more_info @@ -163,7 +155,9 @@ cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result -> NotAModule | otherwise - -> GenericMissing using_cabal (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) mod_hiddens unusables files + -> GenericMissing using_cabal + (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) + mod_hiddens unusables files _ -> panic "cantFindErr" build_tag = waysBuildTag (profileWays profile) @@ -177,4 +171,4 @@ cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result MissingPackageWayFiles build pkg files | otherwise - = MissingPackageFiles pkg files \ No newline at end of file + = MissingPackageFiles pkg files ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -143,7 +143,7 @@ where the code that e1 expands to might import some defns that also turn out to be needed by the code that e2 expands to. -} -tcLookupImported_maybe :: Name -> TcM (MaybeErr MissingInterfaceError TyThing) +tcLookupImported_maybe :: Name -> TcM (MaybeErr InterfaceError TyThing) -- Returns (Failed err) if we can't find the interface file for the thing tcLookupImported_maybe name = do { hsc_env <- getTopEnv @@ -152,7 +152,7 @@ tcLookupImported_maybe name Just thing -> return (Succeeded thing) Nothing -> tcImportDecl_maybe name } -tcImportDecl_maybe :: Name -> TcM (MaybeErr MissingInterfaceError TyThing) +tcImportDecl_maybe :: Name -> TcM (MaybeErr InterfaceError TyThing) -- Entry point for *source-code* uses of importDecl tcImportDecl_maybe name | Just thing <- wiredInNameTyThing_maybe name @@ -163,7 +163,7 @@ tcImportDecl_maybe name | otherwise = initIfaceTcRn (importDecl name) -importDecl :: Name -> IfM lcl (MaybeErr MissingInterfaceError TyThing) +importDecl :: Name -> IfM lcl (MaybeErr InterfaceError TyThing) -- Get the TyThing for this Name from an interface file -- It's not a wired-in thing -- the caller caught that importDecl name @@ -174,15 +174,18 @@ importDecl name -- Load the interface, which should populate the PTE ; mb_iface <- assertPpr (isExternalName name) (ppr name) $ loadInterface nd_doc (nameModule name) ImportBySystem - ; case mb_iface of { - Failed err_msg -> return (Failed err_msg) ; - Succeeded _ -> do + ; case mb_iface of + { Failed err_msg -> return $ Failed $ + Can'tFindInterface err_msg (LookingForName name) + ; Succeeded _ -> do -- Now look it up again; this time we should find it { eps <- getEps ; case lookupTypeEnv (eps_PTE eps) name of Just thing -> return $ Succeeded thing - Nothing -> return $ Failed (MissingDeclInInterface name (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps)) + Nothing -> return $ Failed $ + Can'tFindNameInInterface name + (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps) }}} where nd_doc = text "Need decl for" <+> ppr name @@ -289,8 +292,14 @@ loadSrcInterface :: SDoc loadSrcInterface doc mod want_boot maybe_pkg = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg ; case res of - Failed err -> failWithTc (TcRnMissingInterfaceError err) - Succeeded iface -> return iface } + Failed err -> + failWithTc $ + TcRnInterfaceError $ + Can'tFindInterface err $ + LookingForModule mod want_boot + Succeeded iface -> + return iface + } -- | Like 'loadSrcInterface', but returns a 'MaybeErr'. loadSrcInterface_maybe :: SDoc @@ -886,8 +895,8 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do _ -> do r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc) case r of - Failed _ - -> return r + Failed err + -> return (Failed $ BadIfaceFile err) Succeeded (iface,_fp) -> do r2 <- load_dynamic_too_maybe logger name_cache unit_state @@ -895,7 +904,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do iface loc case r2 of Failed sdoc -> return (Failed sdoc) - Succeeded {} -> return r + Succeeded {} -> return $ Succeeded (iface,_fp) err -> do trace_if logger (text "...not found") return $ Failed $ cannotFindInterface @@ -906,14 +915,18 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do err -- | Check if we need to try the dynamic interface for -dynamic-too -load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ()) +load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> ModIface -> ModLocation + -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc -- Indefinite interfaces are ALWAYS non-dynamic. | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ()) | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc | otherwise = return (Succeeded ()) -load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ()) +load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> ModIface -> ModLocation + -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case Succeeded (dynIface, _) @@ -929,7 +942,9 @@ load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do -read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr MissingInterfaceError (ModIface, FilePath)) +read_file :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> FilePath + -> IO (MaybeErr ReadInterfaceError (ModIface, FilePath)) read_file logger name_cache unit_state dflags wanted_mod file_path = do trace_if logger (text "readIFace" <+> text file_path) @@ -944,7 +959,7 @@ read_file logger name_cache unit_state dflags wanted_mod file_path = do (uninstantiateInstantiatedModule indef_mod) read_result <- readIface dflags name_cache wanted_mod' file_path case read_result of - Failed err -> return (Failed (BadIfaceFile file_path err)) + Failed err -> return (Failed err) Succeeded iface -> return (Succeeded (iface, file_path)) -- Don't forget to fill in the package name... @@ -965,7 +980,7 @@ readIface -> NameCache -> Module -> FilePath - -> IO (MaybeErr MissingInterfaceError ModIface) + -> IO (MaybeErr ReadInterfaceError ModIface) readIface dflags name_cache wanted_mod file_path = do let profile = targetProfile dflags res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path @@ -979,9 +994,9 @@ readIface dflags name_cache wanted_mod file_path = do | otherwise -> return (Failed err) where actual_mod = mi_module iface - err = HiModuleNameMismatchWarn wanted_mod actual_mod + err = HiModuleNameMismatchWarn file_path wanted_mod actual_mod - Left exn -> return (Failed (GenericException exn)) + Left exn -> return (Failed (ExceptionOccurred file_path exn)) {- ********************************************************* ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Iface.Recomp.Flags import GHC.Iface.Env import GHC.Core +import GHC.Tc.Errors.Ppr import GHC.Tc.Utils.Monad import GHC.Hs @@ -83,7 +84,6 @@ import GHC.List (uncons) import Data.Ord import Data.Containers.ListUtils import Data.Bifunctor -import GHC.Tc.Errors.Ppr (missingInterfaceErrorDiagnostic) {- ----------------------------------------------- @@ -293,8 +293,13 @@ check_old_iface hsc_env mod_summary maybe_iface read_result <- readIface read_dflags ncu (ms_mod mod_summary) iface_path case read_result of Failed err -> do - trace_if logger (text "FYI: cannot read old interface file:" $$ nest 4 (formatBulleted $ missingInterfaceErrorDiagnostic False err)) - trace_hi_diffs logger (text "Old interface file was invalid:" $$ nest 4 (formatBulleted $ missingInterfaceErrorDiagnostic False err)) + let blah = readInterfaceErrorDiagnostic err + trace_if logger + $ vcat [ text "FYI: cannot read old interface file:" + , nest 4 (formatBulleted blah) ] + trace_hi_diffs logger $ + vcat [ text "Old interface file was invalid:" + , nest 4 (formatBulleted blah) ] return Nothing Succeeded iface -> do trace_if logger (text "Read the interface file" <+> text iface_path) ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -50,6 +50,7 @@ import GHC.StgToCmm.Types import GHC.Runtime.Heap.Layout import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Ppr import GHC.Tc.TyCl.Build import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType @@ -130,7 +131,7 @@ import GHC.Unit.Module.WholeCoreBindings import Data.IORef import Data.Foldable import GHC.Builtin.Names (ioTyConName, rOOT_MAIN) -import GHC.Tc.Errors.Ppr (missingInterfaceErrorDiagnostic) + import GHC.Utils.Error {- @@ -576,13 +577,14 @@ tcHiBootIface hsc_src mod -- to check consistency against, rather than just when we notice -- that an hi-boot is necessary due to a circular import. { hsc_env <- getTopEnv - ; read_result <- liftIO $ findAndReadIface hsc_env - need (fst (getModuleInstantiation mod)) mod - IsBoot -- Hi-boot file + ; read_result <- liftIO $ findAndReadIface hsc_env need + (fst (getModuleInstantiation mod)) mod + IsBoot -- Hi-boot file ; case read_result of { - Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface - ; mkSelfBootInfo iface tc_iface } ; + Succeeded (iface, _path) -> + do { tc_iface <- initIfaceTcRn $ typecheckIface iface + ; mkSelfBootInfo iface tc_iface } ; Failed err -> -- There was no hi-boot file. But if there is circularity in @@ -598,7 +600,10 @@ tcHiBootIface hsc_src mod Nothing -> return NoSelfBoot -- error cases Just (GWIB { gwib_isBoot = is_boot }) -> case is_boot of - IsBoot -> failWithTc (TcRnMissingInterfaceError (CantFindHiBoot mod err)) + IsBoot -> + let diag = Can'tFindInterface err + (LookingForHiBoot mod) + in failWithTc (TcRnInterfaceError diag) -- The hi-boot file has mysteriously disappeared. NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop) -- Someone below us imported us! @@ -1961,7 +1966,7 @@ tcIfaceGlobal name { mb_thing <- importDecl name -- It's imported; go get it ; case mb_thing of - Failed err -> failIfM (ppr name <+> (formatBulleted $ missingInterfaceErrorDiagnostic False err)) + Failed err -> failIfM (ppr name <+> (formatBulleted $ interfaceErrorDiagnostic False err)) Succeeded thing -> return thing }}} ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -48,6 +48,7 @@ import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Finder import GHC.Tc.Utils.Monad +import GHC.Tc.Errors.Ppr import GHC.Runtime.Interpreter import GHCi.RemoteTypes @@ -120,7 +121,6 @@ import GHC.Iface.Load import GHC.Unit.Home import Data.Either import Control.Applicative -import GHC.Tc.Errors.Types (TcRnMessage(..)) uninitialised :: a uninitialised = panic "Loader not initialised" @@ -792,8 +792,9 @@ getLinkDeps hsc_env pls replace_osuf span mods mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $ loadInterface msg mod (ImportByUser NotBoot) iface <- case mb_iface of - Maybes.Failed err -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError err) + Maybes.Failed err -> + let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags + err_txt = formatBulleted $ missingInterfaceErrorDiagnostic tries err in throwGhcExceptionIO (ProgramError (showSDoc dflags err_txt)) Maybes.Succeeded iface -> return iface ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -44,6 +44,8 @@ import GHC.Core.Type ( Type, mkTyConTy ) import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( TyCon ) +import GHC.Tc.Errors.Ppr + import GHC.Types.SrcLoc ( noSrcSpan ) import GHC.Types.Name ( Name, nameModule_maybe ) import GHC.Types.Id ( idType ) @@ -52,11 +54,13 @@ import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS ) import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName , greMangledName, mkRdrQual ) +import GHC.Types.Unique.DFM import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) import GHC.Driver.Config.Finder ( initFinderOpts ) +import GHC.Driver.Config.Diagnostic ( initTcMessageOpts ) import GHC.Unit.Module ( Module, ModuleName ) -import GHC.Unit.Module.ModIface +import GHC.Unit.Module.ModIface ( ModIface_(mi_exports), ModIface ) import GHC.Unit.Env import GHC.Utils.Panic @@ -69,10 +73,8 @@ import Control.Monad ( unless ) import Data.Maybe ( mapMaybe ) import Unsafe.Coerce ( unsafeCoerce ) import GHC.Linker.Types -import GHC.Types.Unique.DFM import Data.List (unzip4) -import GHC.Tc.Errors.Types (TcRnMessage(..)) -import GHC.Driver.Config.Diagnostic (initTcMessageOpts) + -- | Loads the plugins specified in the pluginModNames field of the dynamic -- flags. Should be called after command line arguments are parsed, but before @@ -331,7 +333,9 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do Nothing -> throwCmdLineErrorS dflags $ hsep [text "Could not determine the exports of the module", ppr mod_name] err -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError (cannotFindModule hsc_env mod_name err)) + let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags + err_txt = formatBulleted $ missingInterfaceErrorDiagnostic tries + $ cannotFindModule hsc_env mod_name err in throwCmdLineErrorS dflags err_txt where doc = text "contains a name used in an invocation of lookupRdrNameInModule" ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -21,9 +21,13 @@ module GHC.Tc.Errors.Ppr , inHsDocContext , TcRnMessageOpts(..) + , interfaceErrorHints + , interfaceErrorReason + , interfaceErrorDiagnostic , missingInterfaceErrorHints , missingInterfaceErrorReason , missingInterfaceErrorDiagnostic + , readInterfaceErrorDiagnostic ) where @@ -1411,9 +1415,10 @@ instance Diagnostic TcRnMessage where hsep [ text "Unknown type variable" <> plural errorVars , text "on the RHS of injectivity condition:" , interpp'SP errorVars ] - - TcRnMissingInterfaceError reason - -> missingInterfaceErrorDiagnostic (tcOptsShowTriedFiles opts) reason + TcRnCan'tFindLocalName name + -> mkSimpleDecorated $ text "Can't find local name: " <+> ppr name + TcRnInterfaceError reason + -> interfaceErrorDiagnostic (tcOptsShowTriedFiles opts) reason diagnosticReason = \case @@ -1877,22 +1882,10 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnUnknownTyVarsOnRhsOfInjCond{} -> ErrorWithoutFlag - TcRnMissingInterfaceError reason - -> case reason of - BadSourceImport {} -> ErrorWithoutFlag - MissingDeclInInterface {} -> ErrorWithoutFlag - HomeModError {} -> ErrorWithoutFlag - DynamicHashMismatchError {} -> ErrorWithoutFlag - CantFindErr {} -> ErrorWithoutFlag - CantFindInstalledErr {} -> ErrorWithoutFlag - HiModuleNameMismatchWarn {} -> ErrorWithoutFlag - BadIfaceFile {} -> ErrorWithoutFlag - FailedToLoadDynamicInterface {} -> ErrorWithoutFlag - GenericException {} -> ErrorWithoutFlag - CantFindLocalName {} -> ErrorWithoutFlag - CantFindHiInterfaceForSig {} -> ErrorWithoutFlag - CantFindHiBoot {} -> ErrorWithoutFlag - InterfaceLookupError {} -> ErrorWithoutFlag + TcRnCan'tFindLocalName {} + -> ErrorWithoutFlag + TcRnInterfaceError err + -> interfaceErrorReason err diagnosticHints = \case @@ -2374,8 +2367,10 @@ instance Diagnostic TcRnMessage where -> noHints TcRnUnknownTyVarsOnRhsOfInjCond{} -> noHints - TcRnMissingInterfaceError reason - -> missingInterfaceErrorHints reason + TcRnCan'tFindLocalName {} + -> noHints + TcRnInterfaceError reason + -> interfaceErrorHints reason diagnosticCode = constructorCode @@ -2390,32 +2385,58 @@ commafyWith conjunction xs = addConjunction $ punctuate comma xs addConjunction (x : xs) = x : addConjunction xs addConjunction _ = panic "commafyWith expected 2 or more elements" +interfaceErrorHints :: InterfaceError -> [GhcHint] +interfaceErrorHints = \ case + Can'tFindInterface err _looking_for -> + missingInterfaceErrorHints err + Can'tFindNameInInterface {} -> + noHints + missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint] -missingInterfaceErrorHints reason = - case reason of - BadSourceImport {} -> noHints - MissingDeclInInterface {} -> noHints - HomeModError {} -> noHints - DynamicHashMismatchError {} -> noHints - CantFindErr {} -> noHints - CantFindInstalledErr {} -> noHints - HiModuleNameMismatchWarn {} -> noHints - BadIfaceFile {} -> noHints - FailedToLoadDynamicInterface {} -> noHints - GenericException {} -> noHints - CantFindLocalName {} -> noHints - CantFindHiInterfaceForSig {} -> noHints - CantFindHiBoot {} -> noHints - InterfaceLookupError {} -> noHints +missingInterfaceErrorHints = \case + BadSourceImport {} -> + noHints + HomeModError {} -> + noHints + DynamicHashMismatchError {} -> + noHints + CantFindErr {} -> + noHints + CantFindInstalledErr {} -> + noHints + BadIfaceFile {} -> + noHints + FailedToLoadDynamicInterface {} -> + noHints + +interfaceErrorReason :: InterfaceError -> DiagnosticReason +interfaceErrorReason (Can'tFindInterface err _) + = missingInterfaceErrorReason err +interfaceErrorReason (Can'tFindNameInInterface {}) + = ErrorWithoutFlag missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason -missingInterfaceErrorReason _reason = ErrorWithoutFlag +missingInterfaceErrorReason = \ case + BadSourceImport {} -> + ErrorWithoutFlag + HomeModError {} -> + ErrorWithoutFlag + DynamicHashMismatchError {} -> + ErrorWithoutFlag + CantFindErr {} -> + ErrorWithoutFlag + CantFindInstalledErr {} -> + ErrorWithoutFlag + BadIfaceFile {} -> + ErrorWithoutFlag + FailedToLoadDynamicInterface {} -> + ErrorWithoutFlag prettyCantFindWhat :: CantFindWhat -> SDoc prettyCantFindWhat CantFindModule = text "Could not find module" prettyCantFindWhat CantLoadModule = text "Could not load module" prettyCantFindWhat CantLoadInterface = text "Failed to load interface for" -prettyCantFindWhat AmbigiousModule = text "Ambiguous module name" +prettyCantFindWhat AmbiguousModule = text "Ambiguous module name" prettyCantFindWhat AmbiguousInterface = text "Ambigious interface for" cantFindError :: Bool -> CantFindInstalled -> DecoratedSDoc @@ -2493,11 +2514,18 @@ cantFindError verbose (CantFindInstalled mod_name what cfir) = in mkSimpleDecorated $ pp_suggestions ms $$ mayShowLocations verbose fps NotAModule -> mkSimpleDecorated $ text "It is not a module in the current program, or in any known package." CouldntFindInFiles fps -> mkSimpleDecorated (vcat (map text fps)) - MultiplePackages pkgs -> mkSimpleDecorated $ - sep [text "it was found in multiple packages:", - hsep (map ppr pkgs)] - MultiplePackages2 mods -> mkSimpleDecorated $ - vcat (map pprMod mods) + MultiplePackages mods + | Just pkgs <- unambiguousPackages + -> mkSimpleDecorated $ + sep [text "it was found in multiple packages:", + hsep (map ppr pkgs)] + | otherwise + -> mkSimpleDecorated $ vcat (map pprMod mods) + where + unambiguousPackages = foldl' unambiguousPackage (Just []) mods + unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) + = Just (moduleUnit m : xs) + unambiguousPackage _ _ = Nothing GenericMissing using_cabal pkg_hiddens mod_hiddens unusables files -> mkSimpleDecorated $ vcat (map (pkg_hidden using_cabal) pkg_hiddens) $$ vcat (map mod_hidden mod_hiddens) $$ @@ -2554,34 +2582,59 @@ mayShowLocations verbose files | otherwise = hang (text "Locations searched:") 2 $ vcat (map text files) +interfaceErrorDiagnostic :: Bool -> InterfaceError -> DecoratedSDoc +interfaceErrorDiagnostic verbose_files = \ case + Can'tFindInterface err looking_for -> + case looking_for of + LookingForName name -> + mkSimpleDecorated $ missingDeclInInterface name [] + LookingForModule mod is_boot -> + mkSimpleDecorated + (text "Could not find" <+> what <+> text "for" <+> quotes (ppr mod)) + `unionDecoratedSDoc` + (missingInterfaceErrorDiagnostic verbose_files err) + where + what + | IsBoot <- is_boot + = text "boot interface" + | otherwise + = text "interface" + LookingForHiBoot mod -> + mkSimpleDecorated + (text "Could not find hi-boot interface for" <+> quotes (ppr mod)) + `unionDecoratedSDoc` + (missingInterfaceErrorDiagnostic verbose_files err) + LookingForSig sig -> + mkSimpleDecorated + (text "Could not find interface file for signature" <+> quotes (ppr sig)) + `unionDecoratedSDoc` + (missingInterfaceErrorDiagnostic verbose_files err) + + Can'tFindNameInInterface name relevant_tyThings -> + mkSimpleDecorated $ missingDeclInInterface name relevant_tyThings + +readInterfaceErrorDiagnostic :: ReadInterfaceError -> DecoratedSDoc +readInterfaceErrorDiagnostic = \ case + ExceptionOccurred fp ex -> + mkSimpleDecorated $ + hang (text "Exception when reading interface file " <+> text fp) + 2 (text (showException ex)) + HiModuleNameMismatchWarn _ m1 m2 -> + mkSimpleDecorated $ hiModuleNameMismatchWarn m1 m2 + missingInterfaceErrorDiagnostic :: Bool -> MissingInterfaceError -> DecoratedSDoc missingInterfaceErrorDiagnostic verbose_files reason = case reason of BadSourceImport m -> mkSimpleDecorated $ badSourceImport m - MissingDeclInInterface name things -> mkSimpleDecorated $ missingDeclInInterface name things HomeModError im ml -> mkSimpleDecorated $ homeModError im ml DynamicHashMismatchError m ml -> mkSimpleDecorated $ dynamicHashMismatchError m ml CantFindErr us cfi -> mkDecorated . map (pprWithUnitState us) . unDecorated $ cantFindError verbose_files cfi CantFindInstalledErr cfi -> cantFindError verbose_files cfi - HiModuleNameMismatchWarn m1 m2 -> mkSimpleDecorated $ hiModuleNameMismatchWarn m1 m2 - BadIfaceFile fp mie -> - -- TODO - mkSimpleDecorated (text fp) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie + BadIfaceFile rie -> readInterfaceErrorDiagnostic rie FailedToLoadDynamicInterface wanted_mod err -> mkSimpleDecorated (text "Failed to load dynamic interface file for" <+> ppr wanted_mod) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files err - GenericException se -> --- mkSimpleDecorated $ text "Exception when reading interface file for" <+> ppr mod - mkSimpleDecorated $ text (showException se) - CantFindLocalName name -> mkSimpleDecorated (text "Can't find local name: " <+> ppr name) - CantFindHiInterfaceForSig isig_mod mie -> - mkSimpleDecorated (text "Could not find hi interface for signature" <+> quotes (ppr isig_mod)) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie - CantFindHiBoot m mie -> - mkSimpleDecorated (text "Could not find hi-boot interface for" <+> quotes (ppr m)) - `unionDecoratedSDoc` missingInterfaceErrorDiagnostic verbose_files mie - InterfaceLookupError _ mie -> missingInterfaceErrorDiagnostic verbose_files mie + `unionDecoratedSDoc` + readInterfaceErrorDiagnostic err hiModuleNameMismatchWarn :: Module -> Module -> SDoc hiModuleNameMismatchWarn requested_mod read_mod @@ -2626,9 +2679,9 @@ missingDeclInInterface :: Name -> [TyThing] -> SDoc missingDeclInInterface name things = whenPprDebug (found_things $$ empty) $$ hang (text "Can't find interface-file declaration for" <+> - pprNameSpace (nameNameSpace name) <+> ppr name) - 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", - text "Use -ddump-if-trace to get an idea of which file caused the error"]) + pprNameSpace (nameNameSpace name) <+> ppr name) + 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", + text "Use -ddump-if-trace to get an idea of which file caused the error"]) where found_things = hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon) ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -49,6 +49,9 @@ module GHC.Tc.Errors.Types ( , FixedRuntimeRepErrorInfo(..) , MissingInterfaceError(..) + , InterfaceLookingFor(..) + , InterfaceError(..) + , ReadInterfaceError(..) , CantFindInstalled(..) , CantFindInstalledReason(..) , CantFindWhat(..) @@ -112,6 +115,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , FixedRuntimeRepOrigin(..) ) import GHC.Tc.Types.Rank (Rank) import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType) +import GHC.Types.Basic import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) import GHC.Types.ForeignCall (CLabelString) @@ -137,7 +141,6 @@ import GHC.Core.TyCon (TyCon, TyConFlavour) import GHC.Core.Type (Kind, Type, ThetaType, PredType) import GHC.Driver.Backend (Backend) import GHC.Unit.State (UnitState, ModuleSuggestion, ModuleOrigin, UnusableUnitReason, UnitInfo) -import GHC.Types.Basic import GHC.Utils.Misc (capitalise, filterOut) import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString (FastString) @@ -3178,7 +3181,9 @@ data TcRnMessage where -} TcRnUnknownTyVarsOnRhsOfInjCond :: [Name] -> TcRnMessage - TcRnMissingInterfaceError :: !MissingInterfaceError -> TcRnMessage + TcRnCan'tFindLocalName :: !Name -> TcRnMessage + + TcRnInterfaceError :: !InterfaceError -> TcRnMessage deriving Generic @@ -3598,41 +3603,61 @@ instance Outputable Exported where ppr IsNotExported = text "IsNotExported" ppr IsExported = text "IsExported" -data MissingInterfaceError = - BadSourceImport !Module - | MissingDeclInInterface !Name [TyThing] - | HomeModError !InstalledModule !ModLocation - | DynamicHashMismatchError !Module !ModLocation - | HiModuleNameMismatchWarn Module Module - | CantFindLocalName Name - -- dodgy? - | GenericException SomeException - -- Can't find errors - | CantFindErr !UnitState CantFindInstalled - | CantFindInstalledErr CantFindInstalled - -- Adding context - | BadIfaceFile FilePath MissingInterfaceError - | FailedToLoadDynamicInterface Module MissingInterfaceError - | CantFindHiInterfaceForSig InstalledModule MissingInterfaceError - | CantFindHiBoot Module MissingInterfaceError - | InterfaceLookupError Name MissingInterfaceError - deriving Generic - -data CantFindInstalledReason = NoUnitIdMatching UnitId [UnitInfo] - | MissingPackageFiles UnitId [FilePath] - | MissingPackageWayFiles String UnitId [FilePath] - | ModuleSuggestion [ModuleSuggestion] [FilePath] - | NotAModule - | CouldntFindInFiles [FilePath] - | GenericMissing BuildingCabalPackage [(Unit, Maybe UnitInfo)] [Unit] [(Unit, UnusableUnitReason)] [FilePath] - -- Ambiguous - | MultiplePackages [Unit] - | MultiplePackages2 [(Module, ModuleOrigin)] - deriving Generic - -data CantFindInstalled = CantFindInstalled ModuleName CantFindWhat CantFindInstalledReason deriving Generic - -data CantFindWhat = CantFindModule | CantLoadModule | CantLoadInterface | AmbiguousInterface | AmbigiousModule +data InterfaceLookingFor + = LookingForName !Name + | LookingForHiBoot !Module + | LookingForModule !ModuleName !IsBootInterface + | LookingForSig !InstalledModule + +data InterfaceError + = Can'tFindInterface + MissingInterfaceError + InterfaceLookingFor + | Can'tFindNameInInterface + Name + [TyThing] -- possibly relevant TyThings + deriving Generic + +data MissingInterfaceError + = BadSourceImport !Module + | HomeModError !InstalledModule !ModLocation + | DynamicHashMismatchError !Module !ModLocation + + -- TODO: common up these two + | CantFindErr !UnitState CantFindInstalled + | CantFindInstalledErr CantFindInstalled + + | BadIfaceFile ReadInterfaceError + | FailedToLoadDynamicInterface Module ReadInterfaceError + deriving Generic + +data ReadInterfaceError + = ExceptionOccurred FilePath SomeException + | HiModuleNameMismatchWarn FilePath Module Module + deriving Generic + +data CantFindInstalledReason + = NoUnitIdMatching UnitId [UnitInfo] + | MissingPackageFiles UnitId [FilePath] + | MissingPackageWayFiles String UnitId [FilePath] + | ModuleSuggestion [ModuleSuggestion] [FilePath] + | NotAModule + | CouldntFindInFiles [FilePath] + | GenericMissing BuildingCabalPackage + [(Unit, Maybe UnitInfo)] [Unit] + [(Unit, UnusableUnitReason)] [FilePath] + | MultiplePackages [(Module, ModuleOrigin)] + deriving Generic + +data CantFindInstalled = + CantFindInstalled ModuleName CantFindWhat CantFindInstalledReason + deriving Generic + +data CantFindWhat + = CantFindModule | CantLoadModule | CantLoadInterface + | AmbiguousInterface | AmbiguousModule + -- TODO? + -------------------------------------------------------------------------------- -- -- Errors used in GHC.Tc.Errors ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2024,7 +2024,7 @@ tcLookupTh name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return (AGlobal thing) - Failed msg -> failWithTc (TcRnMissingInterfaceError (InterfaceLookupError name msg)) + Failed msg -> failWithTc (TcRnInterfaceError msg) }}}} notInScope :: TH.Name -> TcRnMessage ===================================== compiler/GHC/Tc/Utils/Backpack.hs ===================================== @@ -168,7 +168,7 @@ checkHsigIface tcg_env gr sig_iface -- tcg_env (TODO: but maybe this isn't relevant anymore). r <- tcLookupImported_maybe name case r of - Failed err -> addErr (TcRnMissingInterfaceError (InterfaceLookupError name err)) + Failed err -> addErr (TcRnInterfaceError err) Succeeded real_thing -> checkHsigDeclM sig_iface sig_thing real_thing -- The hsig did NOT define this function; that means it must @@ -564,8 +564,7 @@ mergeSignatures ctx = initSDocContext dflags defaultUserStyle fmap fst . withIfaceErr ctx - $ findAndReadIface hsc_env - (text "mergeSignatures") im m NotBoot + $ findAndReadIface hsc_env (text "mergeSignatures") im m NotBoot -- STEP 3: Get the unrenamed exports of all these interfaces, -- thin it according to the export list, and do shaping on them. @@ -996,11 +995,9 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do isig_mod sig_mod NotBoot isig_iface <- case mb_isig_iface of Succeeded (iface, _) -> return iface - Failed err -> failWithTc $ TcRnMissingInterfaceError $ CantFindHiInterfaceForSig isig_mod err - {- - hang (text "Could not find hi interface for signature" <+> - quotes (ppr isig_mod) <> colon) 4 err - -} + Failed err -> + failWithTc $ TcRnInterfaceError $ + Can'tFindInterface err (LookingForSig isig_mod) -- STEP 3: Check that the implementing interface exports everything -- we need. (Notice we IGNORE the Modules in the AvailInfos.) ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -153,12 +153,13 @@ lookupGlobal hsc_env name mb_thing <- lookupGlobal_maybe hsc_env name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts (hsc_dflags hsc_env)) (TcRnMissingInterfaceError msg) + Failed err -> + let err_txt = formatBulleted + $ diagnosticMessage (initTcMessageOpts (hsc_dflags hsc_env)) + err in pprPanic "lookupGlobal" err_txt } - -lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) +lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr TcRnMessage TyThing) -- This may look up an Id that one has previously looked up. -- If so, we are going to read its interface file, and add its bindings -- to the ExternalPackageTable. @@ -169,24 +170,26 @@ lookupGlobal_maybe hsc_env name tcg_semantic_mod = homeModuleInstantiation mhome_unit mod ; if nameIsLocalOrFrom tcg_semantic_mod name - then (return - (Failed (CantFindLocalName name))) - -- Internal names can happen in GHCi - else - -- Try home package table and external package table - lookupImported_maybe hsc_env name + then return $ Failed $ TcRnCan'tFindLocalName name + -- Internal names can happen in GHCi + else do + res <- lookupImported_maybe hsc_env name + -- Try home package table and external package table + return $ case res of + Succeeded ok -> Succeeded ok + Failed err -> Failed (TcRnInterfaceError err) } -lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) +lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr InterfaceError TyThing) -- Returns (Failed err) if we can't find the interface file for the thing lookupImported_maybe hsc_env name = do { mb_thing <- lookupType hsc_env name ; case mb_thing of Just thing -> return (Succeeded thing) Nothing -> importDecl_maybe hsc_env name - } + } -importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr MissingInterfaceError TyThing) +importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr InterfaceError TyThing) importDecl_maybe hsc_env name | Just thing <- wiredInNameTyThing_maybe name = do { when (needWiredInHomeIface thing) @@ -245,7 +248,7 @@ tcLookupGlobal name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> failWithTc (TcRnMissingInterfaceError (InterfaceLookupError name msg)) + Failed msg -> failWithTc (TcRnInterfaceError msg) }}} -- Look up only in this module's global env't. Don't look in imports, etc. ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -217,6 +218,7 @@ import Data.IORef import Control.Monad import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Ppr import {-# SOURCE #-} GHC.Tc.Utils.Env ( tcInitTidyEnv ) import qualified Data.Map as Map @@ -668,8 +670,8 @@ withIfaceErr ctx do_this = do r <- do_this case r of Failed err -> do - let diag = TcRnMissingInterfaceError err - msg = pprDiagnostic diag + let tries = tcOptsShowTriedFiles $ defaultDiagnosticOpts @TcRnMessage + msg = formatBulleted $ missingInterfaceErrorDiagnostic tries err liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx msg)) Succeeded result -> return result ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -530,6 +530,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnShadowedTyVarNameInFamResult" = 99412 GhcDiagnosticCode "TcRnIncorrectTyVarOnLhsOfInjCond" = 88333 GhcDiagnosticCode "TcRnUnknownTyVarsOnRhsOfInjCond" = 48254 + GhcDiagnosticCode "TcRnCan'tFindLocalName" = 11111 -- SLD TODO -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 @@ -583,32 +584,27 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "OneArgExpected" = 91490 GhcDiagnosticCode "AtLeastOneArgExpected" = 07641 - -- Missing interface errors + -- Interface errors GhcDiagnosticCode "BadSourceImport" = 00001 - GhcDiagnosticCode "MissingDeclInInterface" = 00002 - GhcDiagnosticCode "MissingInterfaceError" = 00003 - GhcDiagnosticCode "HomeModError" = 00004 - GhcDiagnosticCode "DynamicHashMismatchError" = 00005 - GhcDiagnosticCode "BadIfaceFile" = 00006 - GhcDiagnosticCode "CantFindLocalName" = 00009 - GhcDiagnosticCode "FailedToLoadDynamicInterface" = 00010 - GhcDiagnosticCode "GenericException" = 00011 - GhcDiagnosticCode "HiModuleNameMismatch" = 00012 - GhcDiagnosticCode "HiModuleNameMismatchWarn" = 00013 - GhcDiagnosticCode "UsedAsDataConstructor" = 00014 - GhcDiagnosticCode "CantFindHiInterfaceForSig" = 00015 - - GhcDiagnosticCode "CouldntFindInFiles" = 00016 - GhcDiagnosticCode "GenericMissing" = 00017 - GhcDiagnosticCode "MissingPackageFiles" = 00018 - GhcDiagnosticCode "MissingPackageWayFiles" = 00019 - GhcDiagnosticCode "ModuleSuggestion" = 00020 - GhcDiagnosticCode "MultiplePackages" = 00021 - GhcDiagnosticCode "MultiplePackages2" = 00022 - GhcDiagnosticCode "NoUnitIdMatching" = 00023 - GhcDiagnosticCode "NotAModule" = 00024 - GhcDiagnosticCode "CantFindHiBoot" = 00025 - + GhcDiagnosticCode "MissingDeclInInterface" = 00002 + GhcDiagnosticCode "MissingInterfaceError" = 00003 + GhcDiagnosticCode "HomeModError" = 00004 + GhcDiagnosticCode "DynamicHashMismatchError" = 00005 + GhcDiagnosticCode "BadIfaceFile" = 00006 + GhcDiagnosticCode "FailedToLoadDynamicInterface" = 00010 + GhcDiagnosticCode "UsedAsDataConstructor" = 00014 + GhcDiagnosticCode "CouldntFindInFiles" = 00016 + GhcDiagnosticCode "GenericMissing" = 00017 + GhcDiagnosticCode "MissingPackageFiles" = 00018 + GhcDiagnosticCode "MissingPackageWayFiles" = 00019 + GhcDiagnosticCode "ModuleSuggestion" = 00020 + GhcDiagnosticCode "MultiplePackages" = 00022 + GhcDiagnosticCode "NoUnitIdMatching" = 00023 + GhcDiagnosticCode "NotAModule" = 00024 + GhcDiagnosticCode "Can'tFindNameInInterface" = 00026 + + GhcDiagnosticCode "HiModuleNameMismatchWarn" = 00012 + GhcDiagnosticCode "ExceptionOccurred" = 00011 -- Out of scope errors GhcDiagnosticCode "NotInScope" = 76037 @@ -702,13 +698,10 @@ type family ConRecursInto con where ConRecursInto "CantFindErr" = 'Just CantFindInstalled ConRecursInto "CantFindInstalledErr" = 'Just CantFindInstalled - ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason + ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason - ConRecursInto "BadIfaceFile" = 'Just MissingInterfaceError - ConRecursInto "FailedToLoadDynamicInterface" = 'Just MissingInterfaceError - ConRecursInto "CantFindHiInterfaceForSig" = 'Just MissingInterfaceError - ConRecursInto "CantFindHiBoot" = 'Just MissingInterfaceError - ConRecursInto "InterfaceLookupError" = 'Just MissingInterfaceError + ConRecursInto "BadIfaceFile" = 'Just ReadInterfaceError + ConRecursInto "FailedToLoadDynamicInterface" = 'Just ReadInterfaceError ---------------------------------- -- Constructors of PsMessage @@ -737,7 +730,10 @@ type family ConRecursInto con where ConRecursInto "TcRnRunSpliceFailure" = 'Just RunSpliceFailReason ConRecursInto "ConversionFail" = 'Just ConversionFailReason - ConRecursInto "TcRnMissingInterfaceError" = 'Just MissingInterfaceError + -- Interface file errors + + ConRecursInto "TcRnInterfaceError" = 'Just InterfaceError + ConRecursInto "Can'tFindInterface" = 'Just MissingInterfaceError ------------------ -- FFI errors ===================================== ghc/Main.hs ===================================== @@ -98,8 +98,7 @@ import GHC.ResponseFile (expandResponse) import Data.Bifunctor import GHC.Data.Graph.Directed import qualified Data.List.NonEmpty as NE -import GHC.Types.Error -import GHC.Tc.Errors.Types (TcRnMessage(..)) +import GHC.Tc.Errors.Types (TcRnMessage(..), InterfaceError (..), InterfaceLookingFor (..)) ----------------------------------------------------------------------------- -- ToDo: @@ -1103,7 +1102,7 @@ abiHash strs = do case r of Found _ m -> return m _error -> - let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnMissingInterfaceError (cannotFindModule hsc_env modname r)) + let err_txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) (TcRnInterfaceError (Can'tFindInterface (cannotFindModule hsc_env modname r) (LookingForModule modname NotBoot))) in throwGhcException . CmdLineError $ showSDoc dflags err_txt mods <- mapM find_it strs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/253385ee13203425aa89f78d3159dfe6e52216a2...abac1c81d6428294878df0a35a42ebfea5c03a8e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/253385ee13203425aa89f78d3159dfe6e52216a2...abac1c81d6428294878df0a35a42ebfea5c03a8e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 11:03:12 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 16 Mar 2023 07:03:12 -0400 Subject: [Git][ghc/ghc][wip/T23051] Be more careful about quantification Message-ID: <6412f7705c022_37e76b34f0b0984377b2@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23051 at Glasgow Haskell Compiler / GHC Commits: 4e06ba8b by Simon Peyton Jones at 2023-03-16T11:04:41+00:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 26 changed files: - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Validity.hs - testsuite/tests/rep-poly/RepPolyArgument.stderr - testsuite/tests/rep-poly/RepPolyDoBind.stderr - testsuite/tests/rep-poly/RepPolyDoBody1.stderr - testsuite/tests/rep-poly/RepPolyDoBody2.stderr - testsuite/tests/rep-poly/RepPolyLeftSection2.stderr - testsuite/tests/rep-poly/RepPolyMcBind.stderr - testsuite/tests/rep-poly/RepPolyMcBody.stderr - testsuite/tests/rep-poly/RepPolyMcGuard.stderr - testsuite/tests/rep-poly/RepPolyNPlusK.stderr - testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr - testsuite/tests/rep-poly/RepPolyRule1.stderr - testsuite/tests/rep-poly/RepPolyTupleSection.stderr - testsuite/tests/rep-poly/T12709.stderr - testsuite/tests/rep-poly/T12973.stderr - testsuite/tests/rep-poly/T13929.stderr - testsuite/tests/rep-poly/T19615.stderr - testsuite/tests/rep-poly/T19709b.stderr - + testsuite/tests/rep-poly/T23051.hs - + testsuite/tests/rep-poly/T23051.stderr - testsuite/tests/rep-poly/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -903,15 +903,19 @@ mkInferredPolyId residual insoluble qtvs inferred_theta poly_name mb_sig_inst mo ; let inferred_poly_ty = mkInvisForAllTys binders (mkPhiTy theta' mono_ty') ; traceTc "mkInferredPolyId" (vcat [ppr poly_name, ppr qtvs, ppr theta' - , ppr inferred_poly_ty]) + , ppr inferred_poly_ty + , text "insoluble" <+> ppr insoluble ]) + ; unless insoluble $ addErrCtxtM (mk_inf_msg poly_name inferred_poly_ty) $ do { checkEscapingKind inferred_poly_ty + -- See Note [Inferred type with escaping kind] ; checkValidType (InfSigCtxt poly_name) inferred_poly_ty } - -- See Note [Validity of inferred types] - -- If we found an insoluble error in the function definition, don't - -- do this check; otherwise (#14000) we may report an ambiguity - -- error for a rather bogus type. + -- See Note [Validity of inferred types] + -- unless insoluble: if we found an insoluble error in the + -- function definition, don't do this check; otherwise + -- (#14000) we may report an ambiguity error for a rather + -- bogus type. ; return (mkLocalId poly_name ManyTy inferred_poly_ty) } @@ -1176,6 +1180,30 @@ Examples that might fail: or multi-parameter type classes - an inferred type that includes unboxed tuples +Note [Inferred type with escaping kind] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Check for an inferred type with an escaping kind; e.g. #23051 + forall {k} {f :: k -> RuntimeRep} {g :: k} {a :: TYPE (f g)}. a +where the kind of the body of the forall mentions `f` and `g` which +are bound by the forall. No no no. + +This check is really in the wrong place: inferred_poly_ty doesn't obey +the PKTI and it would be better not to generalise it in the first +place; see #20686. But for now it works. + +How could avoid generalising over escaping type variables? I considered: + +* Adjust the generalisation in GHC.Tc.Solver to directly check for + escaping kind variables; instead, promote or default them. + +* When inferring the type of a binding, in `tcMonoBinds`, we create + an ExpSigmaType with `tcInfer`. If we simply gave it an ir_frr field + that said "must have fixed runtime rep", then the kind would be made + Concrete; and we never generalise over Concrete variables. A bit + more indirect, but we need the "don't generalise over Concrete variables" + stuff anyway. + + Note [Impedance matching] ~~~~~~~~~~~~~~~~~~~~~~~~~ Consider ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2037,7 +2037,7 @@ typecheck/should_compile/tc170). Moreover in instance heads we get forall-types with kind Constraint. -It's tempting to check that the body kind is either * or #. But this is +It's tempting to check that the body kind is (TYPE _). But this is wrong. For example: class C a b @@ -2046,7 +2046,7 @@ wrong. For example: We're doing newtype-deriving for C. But notice how `a` isn't in scope in the predicate `C a`. So we quantify, yielding `forall a. C a` even though `C a` has kind `* -> Constraint`. The `forall a. C a` is a bit cheeky, but -convenient. Bottom line: don't check for * or # here. +convenient. Bottom line: don't check for (TYPE _) here. Note [Body kind of a HsQualTy] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -3547,8 +3547,12 @@ kindGeneralizeSome skol_info wanted kind_or_type -- here will already have all type variables quantified; -- thus, every free variable is really a kv, never a tv. ; dvs <- candidateQTyVarsOfKind kind_or_type - ; dvs <- filterConstrainedCandidates wanted dvs - ; quantifyTyVars skol_info DefaultNonStandardTyVars dvs } + ; filtered_dvs <- filterConstrainedCandidates wanted dvs + ; traceTc "kindGeneralizeSome" $ + vcat [ text "type:" <+> ppr kind_or_type + , text "dvs:" <+> ppr dvs + , text "filtered_dvs:" <+> ppr filtered_dvs ] + ; quantifyTyVars skol_info DefaultNonStandardTyVars filtered_dvs } filterConstrainedCandidates :: WantedConstraints -- Don't quantify over variables free in these ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1397,7 +1397,7 @@ Note [Deciding quantification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If the monomorphism restriction does not apply, then we quantify as follows: -* Step 1: decideMonoTyVars. +* Step 1: decidePromotedTyVars. Take the global tyvars, and "grow" them using functional dependencies E.g. if x:alpha is in the environment, and alpha ~ [beta] (which can happen because alpha is untouchable here) then do not quantify over @@ -1408,10 +1408,11 @@ If the monomorphism restriction does not apply, then we quantify as follows: We also account for the monomorphism restriction; if it applies, add the free vars of all the constraints. - Result is mono_tvs; we will not quantify over these. + Result is mono_tvs; we will promote all of these to the outer levek, + and certainly not quantify over them. * Step 2: defaultTyVarsAndSimplify. - Default any non-mono tyvars (i.e ones that are definitely + Default any non-promoted tyvars (i.e ones that are definitely not going to become further constrained), and re-simplify the candidate constraints. @@ -1431,7 +1432,7 @@ If the monomorphism restriction does not apply, then we quantify as follows: over are determined in Step 3 (not in Step 1), it is OK for the mono_tvs to be missing some variables free in the environment. This is why removing the psig_qtvs is OK in - decideMonoTyVars. Test case for this scenario: T14479. + decidePromotedTyVars. Test case for this scenario: T14479. * Step 3: decideQuantifiedTyVars. Decide which variables to quantify over, as follows: @@ -1559,7 +1560,7 @@ and we are running simplifyInfer over These are two implication constraints, both of which contain a wanted for the class C. Neither constraint mentions the bound -skolem. We might imagine that these constraint could thus float +skolem. We might imagine that these constraints could thus float out of their implications and then interact, causing beta1 to unify with beta2, but constraints do not currently float out of implications. @@ -1609,12 +1610,12 @@ decideQuantification -- See Note [Deciding quantification] decideQuantification skol_info infer_mode rhs_tclvl name_taus psigs candidates = do { -- Step 1: find the mono_tvs - ; (mono_tvs, candidates, co_vars) <- decideMonoTyVars infer_mode - name_taus psigs candidates + ; (candidates, co_vars) <- decidePromotedTyVars infer_mode + name_taus psigs candidates -- Step 2: default any non-mono tyvars, and re-simplify -- This step may do some unification, but result candidates is zonked - ; candidates <- defaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates + ; candidates <- defaultTyVarsAndSimplify rhs_tclvl candidates -- Step 3: decide which kind/type variables to quantify over ; qtvs <- decideQuantifiedTyVars skol_info name_taus psigs candidates @@ -1647,7 +1648,6 @@ decideQuantification skol_info infer_mode rhs_tclvl name_taus psigs candidates (vcat [ text "infer_mode:" <+> ppr infer_mode , text "candidates:" <+> ppr candidates , text "psig_theta:" <+> ppr psig_theta - , text "mono_tvs:" <+> ppr mono_tvs , text "co_vars:" <+> ppr co_vars , text "qtvs:" <+> ppr qtvs , text "theta:" <+> ppr theta ]) @@ -1686,23 +1686,36 @@ ambiguous types. Something like But that's a battle for another day. -} -decideMonoTyVars :: InferMode - -> [(Name,TcType)] - -> [TcIdSigInst] - -> [PredType] - -> TcM (TcTyCoVarSet, [PredType], CoVarSet) --- Decide which tyvars and covars cannot be generalised: --- (a) Free in the environment --- (b) Mentioned in a constraint we can't generalise --- (c) Connected by an equality or fundep to (a) or (b) +decidePromotedTyVars :: InferMode + -> [(Name,TcType)] + -> [TcIdSigInst] + -> [PredType] + -> TcM ([PredType], CoVarSet) +-- We are about to generalise over type variables at level N +-- Each must be either +-- (P) promoted +-- (D) defaulted +-- (Q) quantified +-- This function finds (P), the type variables that we are going to promote. +-- But we can't generalise over type variables that are: +-- Namely type variables that are: +-- (a) Mentioned in a constraint we can't generalise (the MR) +-- (b) Mentioned in the kind of a CoVar; we can't quantify over a CoVar, +-- so we must not quantify over a type variable free in its kind +-- (c) Connected by an equality or fundep to +-- * a type variable at level < N, or +-- * A tyvar subject to (a), (b) or (c) +-- Having found all such level-N tyvars that we can't generalise, +-- promote them, to eliminate them from further consideration +-- -- Also return CoVars that appear free in the final quantified types -- we can't quantify over these, and we must make sure they are in scope -decideMonoTyVars infer_mode name_taus psigs candidates +decidePromotedTyVars infer_mode name_taus psigs candidates = do { (no_quant, maybe_quant) <- pick infer_mode candidates -- If possible, we quantify over partial-sig qtvs, so they are -- not mono. Need to zonk them because they are meta-tyvar TyVarTvs - ; psig_qtvs <- zonkTcTyVarsToTcTyVars $ binderVars $ + ; psig_qtvs <- zonkTcTyVarsToTcTyVars $ binderVars $ concatMap (map snd . sig_inst_skols) psigs ; psig_theta <- mapM TcM.zonkTcType $ @@ -1713,29 +1726,30 @@ decideMonoTyVars infer_mode name_taus psigs candidates ; tc_lvl <- TcM.getTcLevel ; let psig_tys = mkTyVarTys psig_qtvs ++ psig_theta + -- (b) The co_var_tvs are tvs mentioned in the types of covars or + -- coercion holes. We can't quantify over these covars, so we + -- must include the variable in their types in the mono_tvs. + -- E.g. If we can't quantify over co :: k~Type, then we can't + -- quantify over k either! Hence closeOverKinds co_vars = coVarsOfTypes (psig_tys ++ taus ++ candidates) co_var_tvs = closeOverKinds co_vars - -- The co_var_tvs are tvs mentioned in the types of covars or - -- coercion holes. We can't quantify over these covars, so we - -- must include the variable in their types in the mono_tvs. - -- E.g. If we can't quantify over co :: k~Type, then we can't - -- quantify over k either! Hence closeOverKinds mono_tvs0 = filterVarSet (not . isQuantifiableTv tc_lvl) $ tyCoVarsOfTypes candidates -- We need to grab all the non-quantifiable tyvars in the -- types so that we can grow this set to find other - -- non-quantifiable tyvars. This can happen with something - -- like + -- non-quantifiable tyvars. This can happen with something like -- f x y = ... -- where z = x 3 -- The body of z tries to unify the type of x (call it alpha[1]) -- with (beta[2] -> gamma[2]). This unification fails because - -- alpha is untouchable. But we need to know not to quantify over - -- beta or gamma, because they are in the equality constraint with - -- alpha. Actual test case: typecheck/should_compile/tc213 + -- alpha is untouchable, leaving [W] alpha[1] ~ (beta[2] -> gamma[2]). + -- We need to know not to quantify over beta or gamma, because they + -- are in the equality constraint with alpha. Actual test case: + -- typecheck/should_compile/tc213 mono_tvs1 = mono_tvs0 `unionVarSet` co_var_tvs + -- mono_tvs1 is now the set of variables from an outer scope -- (that's mono_tvs0) and the set of covars, closed over kinds. -- Given this set of variables we know we will not quantify, @@ -1749,9 +1763,8 @@ decideMonoTyVars infer_mode name_taus psigs candidates -- (that is, we might have IP "c" Bool and IP "c" Int in different -- places within the same program), and -- skipping this causes implicit params to monomorphise too many - -- variables; see Note [Inheriting implicit parameters] in - -- GHC.Tc.Solver. Skipping causes typecheck/should_compile/tc219 - -- to fail. + -- variables; see Note [Inheriting implicit parameters] in GHC.Tc.Solver. + -- Skipping causes typecheck/should_compile/tc219 to fail. mono_tvs2 = closeWrtFunDeps non_ip_candidates mono_tvs1 -- mono_tvs2 now contains any variable determined by the "root @@ -1761,7 +1774,7 @@ decideMonoTyVars infer_mode name_taus psigs candidates closeWrtFunDeps non_ip_candidates (tyCoVarsOfTypes no_quant) `minusVarSet` mono_tvs2 -- constrained_tvs: the tyvars that we are not going to - -- quantify solely because of the monomorphism restriction + -- quantify /solely/ because of the monomorphism restriction -- -- (`minusVarSet` mono_tvs2): a type variable is only -- "constrained" (so that the MR bites) if it is not @@ -1783,7 +1796,12 @@ decideMonoTyVars infer_mode name_taus psigs candidates let dia = TcRnMonomorphicBindings (map fst name_taus) diagnosticTc (constrained_tvs `intersectsVarSet` tyCoVarsOfTypes taus) dia - ; traceTc "decideMonoTyVars" $ vcat + -- Promote the mono_tvs + -- See Note [Promote monomorphic tyvars] + ; traceTc "decidePromotedTyVars: promotion:" (ppr mono_tvs) + ; _ <- promoteTyVarSet mono_tvs + + ; traceTc "decidePromotedTyVars" $ vcat [ text "infer_mode =" <+> ppr infer_mode , text "mono_tvs0 =" <+> ppr mono_tvs0 , text "no_quant =" <+> ppr no_quant @@ -1791,7 +1809,7 @@ decideMonoTyVars infer_mode name_taus psigs candidates , text "mono_tvs =" <+> ppr mono_tvs , text "co_vars =" <+> ppr co_vars ] - ; return (mono_tvs, maybe_quant, co_vars) } + ; return (maybe_quant, co_vars) } where pick :: InferMode -> [PredType] -> TcM ([PredType], [PredType]) -- Split the candidates into ones we definitely @@ -1811,48 +1829,34 @@ decideMonoTyVars infer_mode name_taus psigs candidates ------------------- defaultTyVarsAndSimplify :: TcLevel - -> TyCoVarSet -- Promote these mono-tyvars -> [PredType] -- Assumed zonked -> TcM [PredType] -- Guaranteed zonked --- Promote the known-monomorphic tyvars; -- Default any tyvar free in the constraints; -- and re-simplify in case the defaulting allows further simplification -defaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates - = do { -- Promote any tyvars that we cannot generalise - -- See Note [Promote monomorphic tyvars] - ; traceTc "decideMonoTyVars: promotion:" (ppr mono_tvs) - ; _ <- promoteTyVarSet mono_tvs - - -- Default any kind/levity vars +defaultTyVarsAndSimplify rhs_tclvl candidates + = do { -- Default any kind/levity vars ; DV {dv_kvs = cand_kvs, dv_tvs = cand_tvs} <- candidateQTyVarsOfTypes candidates - -- any covars should already be handled by - -- the logic in decideMonoTyVars, which looks at - -- the constraints generated + -- NB1: decidePromotedTyVars has promoted any type variable fixed by the + -- type envt, so they won't be chosen by candidateQTyVarsOfTypes + -- NB2: Defaulting for variables free in tau_tys is done later, by quantifyTyVars + -- Hence looking only at 'candidates' + -- NB3: Any covars should already be handled by + -- the logic in decidePromotedTyVars, which looks at + -- the constraints generated ; poly_kinds <- xoptM LangExt.PolyKinds - ; mapM_ (default_one poly_kinds True) (dVarSetElems cand_kvs) - ; mapM_ (default_one poly_kinds False) (dVarSetElems (cand_tvs `minusDVarSet` cand_kvs)) + ; let default_kv | poly_kinds = default_tv + | otherwise = defaultTyVar DefaultKindVars + default_tv = defaultTyVar (NonStandardDefaulting DefaultNonStandardTyVars) + ; mapM_ default_kv (dVarSetElems cand_kvs) + ; mapM_ default_tv (dVarSetElems (cand_tvs `minusDVarSet` cand_kvs)) ; simplify_cand candidates } where - default_one poly_kinds is_kind_var tv - | not (isMetaTyVar tv) - = return () - | tv `elemVarSet` mono_tvs - = return () - | otherwise - = void $ defaultTyVar - (if not poly_kinds && is_kind_var - then DefaultKindVars - else NonStandardDefaulting DefaultNonStandardTyVars) - -- NB: only pass 'DefaultKindVars' when we know we're dealing with a kind variable. - tv - - -- this common case (no inferred constraints) should be fast - simplify_cand [] = return [] - -- see Note [Unconditionally resimplify constraints when quantifying] + -- See Note [Unconditionally resimplify constraints when quantifying] + simplify_cand [] = return [] -- Fast path simplify_cand candidates = do { clone_wanteds <- newWanteds DefaultOrigin candidates ; WC { wc_simple = simples } <- setTcLevel rhs_tclvl $ @@ -2086,7 +2090,7 @@ sure to quantify over them. This leads to several wrinkles: In the signature for 'g', we cannot quantify over 'b' because it turns out to get unified with 'a', which is free in g's environment. So we carefully - refrain from bogusly quantifying, in GHC.Tc.Solver.decideMonoTyVars. We + refrain from bogusly quantifying, in GHC.Tc.Solver.decidePromotedTyVars. We report the error later, in GHC.Tc.Gen.Bind.chooseInferredQuantifiers. Note [growThetaTyVars vs closeWrtFunDeps] @@ -2122,7 +2126,7 @@ constraint (transitively). We use closeWrtFunDeps in places where we need to know which variables are *always* determined by some seed set. This includes - * when determining the mono-tyvars in decideMonoTyVars. If `a` + * when determining the mono-tyvars in decidePromotedTyVars. If `a` is going to be monomorphic, we need b and c to be also: they are determined by the choice for `a`. * when checking instance coverage, in ===================================== compiler/GHC/Tc/Utils/Concrete.hs ===================================== @@ -37,8 +37,12 @@ import GHC.Tc.Utils.TcMType ( newConcreteTyVar, isFilledMetaTyVar_maybe, writ , emitWantedEq ) import GHC.Types.Basic ( TypeOrKind(..) ) +import GHC.Types.Name ( getOccName ) +import GHC.Types.Name.Occurrence( occNameFS ) import GHC.Utils.Misc ( HasDebugCallStack ) import GHC.Utils.Outputable +import GHC.Data.FastString ( fsLit ) + import Control.Monad ( void ) import Data.Functor ( ($>) ) @@ -495,7 +499,7 @@ unifyConcrete frr_orig ty -- Create a new ConcreteTv metavariable @concrete_tv@ -- and unify @ty ~# concrete_tv at . ; _ -> - do { conc_tv <- newConcreteTyVar (ConcreteFRR frr_orig) ki + do { conc_tv <- newConcreteTyVar (ConcreteFRR frr_orig) (fsLit "cx") ki -- NB: newConcreteTyVar asserts that 'ki' is concrete. ; coToMCo <$> emitWantedEq orig KindLevel Nominal ty (mkTyVarTy conc_tv) } } } where @@ -647,9 +651,12 @@ makeTypeConcrete conc_orig ty = , TauTv <- metaTyVarInfo tv -> -- Change the MetaInfo to ConcreteTv, but retain the TcLevel do { kind <- go (tyVarKind tv) + ; let occ_fs = occNameFS (getOccName tv) + -- occ_fs: preserve the occurrence name of the original tyvar + -- This helps in error messages ; lift $ do { conc_tv <- setTcLevel (tcTyVarLevel tv) $ - newConcreteTyVar conc_orig kind + newConcreteTyVar conc_orig occ_fs kind ; let conc_ty = mkTyVarTy conc_tv ; writeMetaTyVar tv conc_ty ; return conc_ty } } ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -45,8 +45,6 @@ module GHC.Tc.Utils.TcMType ( unpackCoercionHole, unpackCoercionHole_maybe, checkCoercionHole, - ConcreteHole, newConcreteHole, - newImplication, -------------------------------- @@ -414,23 +412,6 @@ checkCoercionHole cv co | otherwise = False --- | A coercion hole used to store evidence for `Concrete#` constraints. --- --- See Note [The Concrete mechanism]. -type ConcreteHole = CoercionHole - --- | Create a new (initially unfilled) coercion hole, --- to hold evidence for a @'Concrete#' (ty :: ki)@ constraint. -newConcreteHole :: Kind -- ^ Kind of the thing we want to ensure is concrete (e.g. 'runtimeRepTy') - -> Type -- ^ Thing we want to ensure is concrete (e.g. some 'RuntimeRep') - -> TcM (ConcreteHole, TcType) - -- ^ where to put the evidence, and a metavariable to store - -- the concrete type -newConcreteHole ki ty - = do { concrete_ty <- newFlexiTyVarTy ki - ; let co_ty = mkHeteroPrimEqPred ki ki ty concrete_ty - ; hole <- newCoercionHole co_ty - ; return (hole, concrete_ty) } {- ********************************************************************** * @@ -840,11 +821,13 @@ cloneTyVarTyVar name kind -- -- Invariant: the kind must be concrete, as per Note [ConcreteTv]. -- This is checked with an assertion. -newConcreteTyVar :: HasDebugCallStack => ConcreteTvOrigin -> TcKind -> TcM TcTyVar -newConcreteTyVar reason kind = - assertPpr (isConcrete kind) - (text "newConcreteTyVar: non-concrete kind" <+> ppr kind) - $ newAnonMetaTyVar (ConcreteTv reason) kind +newConcreteTyVar :: HasDebugCallStack => ConcreteTvOrigin + -> FastString -> TcKind -> TcM TcTyVar +newConcreteTyVar reason fs kind + = assertPpr (isConcrete kind) assert_msg $ + newNamedAnonMetaTyVar fs (ConcreteTv reason) kind + where + assert_msg = text "newConcreteTyVar: non-concrete kind" <+> ppr kind newPatSigTyVar :: Name -> Kind -> TcM TcTyVar newPatSigTyVar name kind @@ -1242,14 +1225,14 @@ NB: this is all rather similar to, but sadly not the same as Wrinkle: -We must make absolutely sure that alpha indeed is not -from an outer context. (Otherwise, we might indeed learn more information -about it.) This can be done easily: we just check alpha's TcLevel. -That level must be strictly greater than the ambient TcLevel in order -to treat it as naughty. We say "strictly greater than" because the call to +We must make absolutely sure that alpha indeed is not from an outer +context. (Otherwise, we might indeed learn more information about it.) +This can be done easily: we just check alpha's TcLevel. That level +must be strictly greater than the ambient TcLevel in order to treat it +as naughty. We say "strictly greater than" because the call to candidateQTyVars is made outside the bumped TcLevel, as stated in the -comment to candidateQTyVarsOfType. The level check is done in go_tv -in collect_cand_qtvs. Skipping this check caused #16517. +comment to candidateQTyVarsOfType. The level check is done in go_tv in +collect_cand_qtvs. Skipping this check caused #16517. -} @@ -1349,8 +1332,9 @@ candidateQTyVarsWithBinders :: [TyVar] -> Type -> TcM CandidatesQTvs -- Because we are going to scoped-sort the quantified variables -- in among the tvs candidateQTyVarsWithBinders bound_tvs ty - = do { kvs <- candidateQTyVarsOfKinds (map tyVarKind bound_tvs) - ; all_tvs <- collect_cand_qtvs ty False emptyVarSet kvs ty + = do { kvs <- candidateQTyVarsOfKinds (map tyVarKind bound_tvs) + ; cur_lvl <- getTcLevel + ; all_tvs <- collect_cand_qtvs ty False cur_lvl emptyVarSet kvs ty ; return (all_tvs `delCandidates` bound_tvs) } -- | Gathers free variables to use as quantification candidates (in @@ -1362,14 +1346,18 @@ candidateQTyVarsWithBinders bound_tvs ty -- See Note [Dependent type variables] candidateQTyVarsOfType :: TcType -- not necessarily zonked -> TcM CandidatesQTvs -candidateQTyVarsOfType ty = collect_cand_qtvs ty False emptyVarSet mempty ty +candidateQTyVarsOfType ty + = do { cur_lvl <- getTcLevel + ; collect_cand_qtvs ty False cur_lvl emptyVarSet mempty ty } -- | Like 'candidateQTyVarsOfType', but over a list of types -- The variables to quantify must have a TcLevel strictly greater than -- the ambient level. (See Wrinkle in Note [Naughty quantification candidates]) candidateQTyVarsOfTypes :: [Type] -> TcM CandidatesQTvs -candidateQTyVarsOfTypes tys = foldlM (\acc ty -> collect_cand_qtvs ty False emptyVarSet acc ty) - mempty tys +candidateQTyVarsOfTypes tys + = do { cur_lvl <- getTcLevel + ; foldlM (\acc ty -> collect_cand_qtvs ty False cur_lvl emptyVarSet acc ty) + mempty tys } -- | Like 'candidateQTyVarsOfType', but consider every free variable -- to be dependent. This is appropriate when generalizing a *kind*, @@ -1377,16 +1365,21 @@ candidateQTyVarsOfTypes tys = foldlM (\acc ty -> collect_cand_qtvs ty False empt -- to Type.) candidateQTyVarsOfKind :: TcKind -- Not necessarily zonked -> TcM CandidatesQTvs -candidateQTyVarsOfKind ty = collect_cand_qtvs ty True emptyVarSet mempty ty +candidateQTyVarsOfKind ty + = do { cur_lvl <- getTcLevel + ; collect_cand_qtvs ty True cur_lvl emptyVarSet mempty ty } candidateQTyVarsOfKinds :: [TcKind] -- Not necessarily zonked -> TcM CandidatesQTvs -candidateQTyVarsOfKinds tys = foldM (\acc ty -> collect_cand_qtvs ty True emptyVarSet acc ty) - mempty tys +candidateQTyVarsOfKinds tys + = do { cur_lvl <- getTcLevel + ; foldM (\acc ty -> collect_cand_qtvs ty True cur_lvl emptyVarSet acc ty) + mempty tys } collect_cand_qtvs - :: TcType -- original type that we started recurring into; for errors + :: TcType -- Original type that we started recurring into; for errors -> Bool -- True <=> consider every fv in Type to be dependent + -> TcLevel -- Current TcLevel; collect only tyvars whose level is greater -> VarSet -- Bound variables (locals only) -> CandidatesQTvs -- Accumulating parameter -> Type -- Not necessarily zonked @@ -1403,7 +1396,7 @@ collect_cand_qtvs -- so that subsequent dependency analysis (to build a well -- scoped telescope) works correctly -collect_cand_qtvs orig_ty is_dep bound dvs ty +collect_cand_qtvs orig_ty is_dep cur_lvl bound dvs ty = go dvs ty where is_bound tv = tv `elemVarSet` bound @@ -1411,13 +1404,13 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty ----------------- go :: CandidatesQTvs -> TcType -> TcM CandidatesQTvs -- Uses accumulating-parameter style - go dv (AppTy t1 t2) = foldlM go dv [t1, t2] - go dv (TyConApp tc tys) = go_tc_args dv (tyConBinders tc) tys + go dv (AppTy t1 t2) = foldlM go dv [t1, t2] + go dv (TyConApp tc tys) = go_tc_args dv (tyConBinders tc) tys go dv (FunTy _ w arg res) = foldlM go dv [w, arg, res] - go dv (LitTy {}) = return dv - go dv (CastTy ty co) = do dv1 <- go dv ty - collect_cand_qtvs_co orig_ty bound dv1 co - go dv (CoercionTy co) = collect_cand_qtvs_co orig_ty bound dv co + go dv (LitTy {}) = return dv + go dv (CastTy ty co) = do { dv1 <- go dv ty + ; collect_cand_qtvs_co orig_ty cur_lvl bound dv1 co } + go dv (CoercionTy co) = collect_cand_qtvs_co orig_ty cur_lvl bound dv co go dv (TyVarTy tv) | is_bound tv = return dv @@ -1427,8 +1420,8 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty Nothing -> go_tv dv tv } go dv (ForAllTy (Bndr tv _) ty) - = do { dv1 <- collect_cand_qtvs orig_ty True bound dv (tyVarKind tv) - ; collect_cand_qtvs orig_ty is_dep (bound `extendVarSet` tv) dv1 ty } + = do { dv1 <- collect_cand_qtvs orig_ty True cur_lvl bound dv (tyVarKind tv) + ; collect_cand_qtvs orig_ty is_dep cur_lvl (bound `extendVarSet` tv) dv1 ty } -- This makes sure that we default e.g. the alpha in Proxy alpha (Any alpha). -- Tested in polykinds/NestedProxies. @@ -1437,7 +1430,7 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty -- to look at kinds. go_tc_args dv (tc_bndr:tc_bndrs) (ty:tys) = do { dv1 <- collect_cand_qtvs orig_ty (is_dep || isNamedTyConBinder tc_bndr) - bound dv ty + cur_lvl bound dv ty ; go_tc_args dv1 tc_bndrs tys } go_tc_args dv _bndrs tys -- _bndrs might be non-empty: undersaturation -- tys might be non-empty: oversaturation @@ -1446,6 +1439,22 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty ----------------- go_tv dv@(DV { dv_kvs = kvs, dv_tvs = tvs }) tv + | tcTyVarLevel tv <= cur_lvl + = return dv -- This variable is from an outer context; skip + -- See Note [Use level numbers for quantification] + + | case tcTyVarDetails tv of + SkolemTv _ lvl _ -> lvl > pushTcLevel cur_lvl + _ -> False + = return dv -- Skip inner skolems + -- This only happens for erroneous program with bad telescopes + -- e.g. BadTelescope2: forall a k (b :: k). SameKind a b + -- We have (a::k), and at the outer we don't want to quantify + -- over the already-quantified skolem k. + -- (Apparently we /do/ want to quantify over skolems whose level sk_lvl is + -- sk_lvl > cur_lvl, but we definitely do; you get lots of failures otherwise. + -- A battle for another day.) + | tv `elemDVarSet` kvs = return dv -- We have met this tyvar already @@ -1461,17 +1470,7 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty -- (which comes next) works correctly ; let tv_kind_vars = tyCoVarsOfType tv_kind - ; cur_lvl <- getTcLevel - ; if | tcTyVarLevel tv <= cur_lvl - -> return dv -- this variable is from an outer context; skip - -- See Note [Use level numbers for quantification] - - | case tcTyVarDetails tv of - SkolemTv _ lvl _ -> lvl > pushTcLevel cur_lvl - _ -> False - -> return dv -- Skip inner skolems; ToDo: explain - - | intersectsVarSet bound tv_kind_vars + ; if | intersectsVarSet bound tv_kind_vars -- the tyvar must not be from an outer context, but we have -- already checked for this. -- See Note [Naughty quantification candidates] @@ -1490,25 +1489,26 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty -- See Note [Order of accumulation] -- See Note [Recurring into kinds for candidateQTyVars] - ; collect_cand_qtvs orig_ty True bound dv' tv_kind } } + ; collect_cand_qtvs orig_ty True cur_lvl bound dv' tv_kind } } collect_cand_qtvs_co :: TcType -- original type at top of recursion; for errors + -> TcLevel -> VarSet -- bound variables -> CandidatesQTvs -> Coercion -> TcM CandidatesQTvs -collect_cand_qtvs_co orig_ty bound = go_co +collect_cand_qtvs_co orig_ty cur_lvl bound = go_co where - go_co dv (Refl ty) = collect_cand_qtvs orig_ty True bound dv ty - go_co dv (GRefl _ ty mco) = do dv1 <- collect_cand_qtvs orig_ty True bound dv ty - go_mco dv1 mco + go_co dv (Refl ty) = collect_cand_qtvs orig_ty True cur_lvl bound dv ty + go_co dv (GRefl _ ty mco) = do { dv1 <- collect_cand_qtvs orig_ty True cur_lvl bound dv ty + ; go_mco dv1 mco } go_co dv (TyConAppCo _ _ cos) = foldlM go_co dv cos go_co dv (AppCo co1 co2) = foldlM go_co dv [co1, co2] go_co dv (FunCo _ _ _ w co1 co2) = foldlM go_co dv [w, co1, co2] go_co dv (AxiomInstCo _ _ cos) = foldlM go_co dv cos go_co dv (AxiomRuleCo _ cos) = foldlM go_co dv cos - go_co dv (UnivCo prov _ t1 t2) = do dv1 <- go_prov dv prov - dv2 <- collect_cand_qtvs orig_ty True bound dv1 t1 - collect_cand_qtvs orig_ty True bound dv2 t2 + go_co dv (UnivCo prov _ t1 t2) = do { dv1 <- go_prov dv prov + ; dv2 <- collect_cand_qtvs orig_ty True cur_lvl bound dv1 t1 + ; collect_cand_qtvs orig_ty True cur_lvl bound dv2 t2 } go_co dv (SymCo co) = go_co dv co go_co dv (TransCo co1 co2) = foldlM go_co dv [co1, co2] go_co dv (SelCo _ co) = go_co dv co @@ -1527,7 +1527,7 @@ collect_cand_qtvs_co orig_ty bound = go_co go_co dv (ForAllCo tcv kind_co co) = do { dv1 <- go_co dv kind_co - ; collect_cand_qtvs_co orig_ty (bound `extendVarSet` tcv) dv1 co } + ; collect_cand_qtvs_co orig_ty cur_lvl (bound `extendVarSet` tcv) dv1 co } go_mco dv MRefl = return dv go_mco dv (MCo co) = go_co dv co @@ -1543,7 +1543,7 @@ collect_cand_qtvs_co orig_ty bound = go_co | cv `elemVarSet` cvs = return dv -- See Note [Recurring into kinds for candidateQTyVars] - | otherwise = collect_cand_qtvs orig_ty True bound + | otherwise = collect_cand_qtvs orig_ty True cur_lvl bound (dv { dv_cvs = cvs `extendVarSet` cv }) (idType cv) @@ -1810,17 +1810,30 @@ defaultTyVar def_strat tv = do { traceTc "Defaulting a RuntimeRep var to LiftedRep" (ppr tv) ; writeMetaTyVar tv liftedRepTy ; return True } + | isLevityVar tv , default_ns_vars = do { traceTc "Defaulting a Levity var to Lifted" (ppr tv) ; writeMetaTyVar tv liftedDataConTy ; return True } + | isMultiplicityVar tv , default_ns_vars = do { traceTc "Defaulting a Multiplicity var to Many" (ppr tv) ; writeMetaTyVar tv manyDataConTy ; return True } + | isConcreteTyVar tv + -- We don't want to quantify; but neither can we default to + -- anything sensible. (If it has kind RuntimeRep or Levity, as is + -- often the case, it'll have been caught earlier by earlier + -- cases. So in this exotic situation we just promote. Not very + -- satisfing, but it's very much a corner case: #23051 + -- We should really implement the plan in #20686. + = do { lvl <- getTcLevel + ; _ <- promoteMetaTyVarTo lvl tv + ; return True } + | DefaultKindVars <- def_strat -- -XNoPolyKinds and this is a kind var: we must default it = default_kind_var tv @@ -1965,7 +1978,7 @@ What do do? D. We could error. We choose (D), as described in #17567, and implement this choice in -doNotQuantifyTyVars. Discussion of alternativs A-C is below. +doNotQuantifyTyVars. Discussion of alternatives A-C is below. NB: this is all rather similar to, but sadly not the same as Note [Naughty quantification candidates] ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -475,7 +475,7 @@ This is not OK: we get MkT :: forall l. T @l :: TYPE (BoxedRep l) which is ill-kinded. -For ordinary /user-written type signatures f :: blah, we make this +For ordinary /user-written/ type signatures f :: blah, we make this check as part of kind-checking the type signature in tcHsSigType; see Note [Escaping kind in type signatures] in GHC.Tc.Gen.HsType. ===================================== testsuite/tests/rep-poly/RepPolyArgument.stderr ===================================== @@ -3,8 +3,8 @@ RepPolyArgument.hs:10:18: error: [GHC-55287] • The argument ‘(undefined @(R @RuntimeRep))’ of ‘undefined’ does not have a fixed runtime representation. Its type is: - t0 :: TYPE c0 - Cannot unify ‘R’ with the type variable ‘c0’ + t1 :: TYPE t0 + Cannot unify ‘R’ with the type variable ‘t0’ because it is not a concrete ‘RuntimeRep’. • In the first argument of ‘undefined’, namely ‘(undefined @(R @RuntimeRep))’ ===================================== testsuite/tests/rep-poly/RepPolyDoBind.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyDoBind.hs:26:3: error: [GHC-55287] arising from a do statement does not have a fixed runtime representation. Its type is: - ma0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + ma0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a 'do' block: a <- undefined In the expression: ===================================== testsuite/tests/rep-poly/RepPolyDoBody1.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyDoBody1.hs:24:3: error: [GHC-55287] arising from a do statement does not have a fixed runtime representation. Its type is: - ma0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + ma0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a 'do' block: undefined :: ma In the expression: ===================================== testsuite/tests/rep-poly/RepPolyDoBody2.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyDoBody2.hs:23:3: error: [GHC-55287] arising from a do statement does not have a fixed runtime representation. Its type is: - mb0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + mb0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a 'do' block: undefined :: () In the expression: ===================================== testsuite/tests/rep-poly/RepPolyLeftSection2.stderr ===================================== @@ -3,8 +3,8 @@ RepPolyLeftSection2.hs:14:11: error: [GHC-55287] • The argument ‘undefined’ of ‘f’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ + a0 :: TYPE r0 + Cannot unify ‘r’ with the type variable ‘r0’ because it is not a concrete ‘RuntimeRep’. • In the expression: undefined `f` In an equation for ‘test1’: test1 = (undefined `f`) ===================================== testsuite/tests/rep-poly/RepPolyMcBind.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyMcBind.hs:26:16: error: [GHC-55287] arising from a statement in a monad comprehension does not have a fixed runtime representation. Its type is: - ma0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + ma0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a monad comprehension: x <- undefined :: ma In the expression: [() | x <- undefined :: ma] ===================================== testsuite/tests/rep-poly/RepPolyMcBody.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyMcBody.hs:30:16: error: [GHC-55287] arising from a statement in a monad comprehension does not have a fixed runtime representation. Its type is: - ma0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + ma0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a monad comprehension: True In the expression: [() | True] ===================================== testsuite/tests/rep-poly/RepPolyMcGuard.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyMcGuard.hs:30:16: error: [GHC-55287] arising from a statement in a monad comprehension does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + a0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a monad comprehension: undefined In the expression: [() | undefined] ===================================== testsuite/tests/rep-poly/RepPolyNPlusK.stderr ===================================== @@ -3,4 +3,4 @@ RepPolyNPlusK.hs:22:1: error: [GHC-55287] The first pattern in the equation for ‘foo’ does not have a fixed runtime representation. Its type is: - a :: TYPE rep1 + a :: TYPE rep2 ===================================== testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr ===================================== @@ -17,8 +17,8 @@ RepPolyRecordUpdate.hs:13:9: error: [GHC-55287] • The record update at field ‘fld’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c1 - Cannot unify ‘rep’ with the type variable ‘c1’ + a0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a record update at field ‘fld’, with type constructor ‘X’ ===================================== testsuite/tests/rep-poly/RepPolyRule1.stderr ===================================== @@ -3,8 +3,8 @@ RepPolyRule1.hs:11:51: error: [GHC-55287] • The argument ‘x’ of ‘f’ does not have a fixed runtime representation. Its type is: - a1 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + a1 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In the first argument of ‘f’, namely ‘x’ In the expression: f x @@ -16,8 +16,8 @@ RepPolyRule1.hs:11:55: error: [GHC-55287] • The argument ‘x’ of ‘f’ does not have a fixed runtime representation. Its type is: - a1 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + a1 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In the expression: x When checking the rewrite rule "f_id" ===================================== testsuite/tests/rep-poly/RepPolyTupleSection.stderr ===================================== @@ -3,8 +3,8 @@ RepPolyTupleSection.hs:11:7: error: [GHC-55287] • The second component of the tuple section does not have a fixed runtime representation. Its type is: - t0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ + t1 :: TYPE t0 + Cannot unify ‘r’ with the type variable ‘t0’ because it is not a concrete ‘RuntimeRep’. • In the expression: (# 3#, #) In an equation for ‘foo’: foo = (# 3#, #) ===================================== testsuite/tests/rep-poly/T12709.stderr ===================================== @@ -3,8 +3,8 @@ T12709.hs:28:13: error: [GHC-55287] • The argument ‘1’ of ‘(+)’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + a0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In the expression: 1 + 2 + 3 + 4 In an equation for ‘u’: u = 1 + 2 + 3 + 4 ===================================== testsuite/tests/rep-poly/T12973.stderr ===================================== @@ -3,8 +3,8 @@ T12973.hs:13:7: error: [GHC-55287] • The argument ‘3’ of ‘(+)’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ + a0 :: TYPE r0 + Cannot unify ‘r’ with the type variable ‘r0’ because it is not a concrete ‘RuntimeRep’. • In the expression: 3 + 4 In an equation for ‘foo’: foo = 3 + 4 ===================================== testsuite/tests/rep-poly/T13929.stderr ===================================== @@ -3,8 +3,8 @@ T13929.hs:29:24: error: [GHC-55287] • The tuple argument in first position does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘rf’ with the type variable ‘c0’ + a0 :: TYPE k00 + Cannot unify ‘rf’ with the type variable ‘k00’ because it is not a concrete ‘RuntimeRep’. • In the expression: (# gunbox x, gunbox y #) In an equation for ‘gunbox’: ===================================== testsuite/tests/rep-poly/T19615.stderr ===================================== @@ -3,8 +3,8 @@ T19615.hs:17:21: error: [GHC-55287] • The argument ‘(f x)’ of ‘lift'’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r'’ with the type variable ‘c0’ + a0 :: TYPE r0 + Cannot unify ‘r'’ with the type variable ‘r0’ because it is not a concrete ‘RuntimeRep’. • In the first argument of ‘lift'’, namely ‘(f x)’ In the expression: lift' (f x) id ===================================== testsuite/tests/rep-poly/T19709b.stderr ===================================== @@ -3,8 +3,8 @@ T19709b.hs:11:15: error: [GHC-55287] • The argument ‘(error @Any "e2")’ of ‘levfun’ does not have a fixed runtime representation. Its type is: - a1 :: TYPE c0 - Cannot unify ‘Any’ with the type variable ‘c0’ + a1 :: TYPE r0 + Cannot unify ‘Any’ with the type variable ‘r0’ because it is not a concrete ‘RuntimeRep’. • In the first argument of ‘levfun’, namely ‘(error @Any "e2")’ In the first argument of ‘seq’, namely ‘levfun (error @Any "e2")’ ===================================== testsuite/tests/rep-poly/T23051.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash #-} +module M where + +import GHC.Exts + +i :: forall k (f :: k -> RuntimeRep) (g :: k) (a :: TYPE (f g)). a -> a +i = i + +x = i 0# ===================================== testsuite/tests/rep-poly/T23051.stderr ===================================== @@ -0,0 +1,10 @@ + +T23051.hs:9:7: error: [GHC-18872] + • Couldn't match kind ‘IntRep’ with ‘f0 g0’ + When matching types + a :: TYPE (f0 g0) + Int# :: TYPE IntRep + • In the first argument of ‘i’, namely ‘0#’ + In the expression: i 0# + In an equation for ‘x’: x = i 0# + • Relevant bindings include x :: a (bound at T23051.hs:9:1) ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -113,3 +113,6 @@ test('RepPolyTuple2', normal, compile_fail, ['']) ## see #21683 ## test('T21650_a', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## ############################################################################### + + +test('T23051', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e06ba8b1168d7346090848433aff9311fb1a2f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e06ba8b1168d7346090848433aff9311fb1a2f9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 11:35:25 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 16 Mar 2023 07:35:25 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] WIP: Better Hash Message-ID: <6412fefd1ad7e_37e76b358068b44461f4@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 848c2265 by romes at 2023-03-16T11:35:17+00:00 WIP: Better Hash - - - - - 5 changed files: - hadrian/hadrian.cabal - hadrian/src/Hadrian/Package.hs - + hadrian/src/Hadrian/Package/Hash.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -163,6 +163,8 @@ executable hadrian , transformers >= 0.4 && < 0.7 , unordered-containers >= 0.2.1 && < 0.3 , text >= 1.2 && < 3 + , cryptohash-sha256 >= 0.11 && < 0.12 + , base16-bytestring >= 0.1.1 && < 1.1.0.0 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Hadrian/Package.hs ===================================== @@ -81,4 +81,4 @@ instance NFData PackageType instance Binary Package instance Hashable Package -instance NFData Package \ No newline at end of file +instance NFData Package ===================================== hadrian/src/Hadrian/Package/Hash.hs ===================================== @@ -0,0 +1,138 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NamedFieldPuns #-} +module Hadrian.Package.Hash where + +import Hadrian.Haskell.Cabal.Type +import Hadrian.Oracles.Cabal +import Hadrian.Package + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as BS + +-- | Compute the unit-id of a package +pkgUnitId :: Package -> String +pkgUnitId pkg = do + pid <- pkgIdentifier pkg + phash <- pkgHash pkg + pure $ pkgId <> "-" <> hash + + +data PackageHashInputs = PackageHashInputs { + pkgHashPkgId :: String, -- ^ name-version + pkgHashComponent :: PackageType, + pkgHashSourceHash :: BS.ByteString, + -- pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion), + pkgHashDirectDeps :: [PackageName], -- Set InstalledPackageId, -- pkgDependencies are names only, not their installed unit-ids + pkgHashOtherConfig :: PackageHashConfigInputs + } + +-- | Those parts of the package configuration that contribute to the +-- package hash computed by hadrian (which is simpler than cabal's). +-- +-- setting in Oracle.setting, which come from system.config +data PackageHashConfigInputs = PackageHashConfigInputs { + pkgHashCompilerId :: String, + pkgHashPlatform :: String, + -- pkgHashFlagAssignment :: FlagAssignment, -- complete not partial + -- pkgHashConfigureScriptArgs :: [String], -- just ./configure for build-type Configure + pkgHashVanillaLib :: Bool, + pkgHashSharedLib :: Bool, + pkgHashDynExe :: Bool, + pkgHashFullyStaticExe :: Bool, + pkgHashGHCiLib :: Bool, + pkgHashProfLib :: Bool, + pkgHashProfExe :: Bool, + pkgHashProfLibDetail :: ProfDetailLevel, + pkgHashProfExeDetail :: ProfDetailLevel, + pkgHashCoverage :: Bool, + pkgHashOptimization :: OptimisationLevel, + pkgHashSplitObjs :: Bool, + pkgHashSplitSections :: Bool, + pkgHashStripLibs :: Bool, + pkgHashStripExes :: Bool, + pkgHashDebugInfo :: DebugInfoLevel, + pkgHashProgramArgs :: Map String [String], + pkgHashExtraLibDirs :: [FilePath], + pkgHashExtraLibDirsStatic :: [FilePath], + pkgHashExtraFrameworkDirs :: [FilePath], + pkgHashExtraIncludeDirs :: [FilePath], + -- pkgHashProgPrefix :: Maybe PathTemplate, + -- pkgHashProgSuffix :: Maybe PathTemplate, + pkgHashPackageDbs :: [Maybe PackageDB] + } + deriving Show + +pkgHash :: Package -> Action String +pkgHash pkg = BS.unpack $ Base16.encode $ SHA256.hash $ do + pkgIdentifier + renderPackageHashInputs $ PackageHashInputs + { + pkgHashPkgId = undefined + , pkgHashComponent = undefined + , pkgHashSourceHash = undefined + , pkgHashDirectDeps = undefined + , pkgHashOtherConfig = undefined + } + +renderPackageHashInputs :: PackageHashInputs -> BS.ByteString +renderPackageHashInputs PackageHashInputs{ + pkgHashPkgId, + pkgHashComponent, + pkgHashSourceHash, + pkgHashDirectDeps, + -- pkgHashPkgConfigDeps, + pkgHashOtherConfig = + PackageHashConfigInputs{..} + } = + -- The purpose of this somewhat laboured rendering (e.g. why not just + -- use show?) is so that existing package hashes do not change + -- unnecessarily when new configuration inputs are added into the hash. + BS.pack $ unlines $ catMaybes $ + [ entry "pkgid" prettyShow pkgHashPkgId + , mentry "component" show pkgHashComponent + , entry "src" showHashValue pkgHashSourceHash + , entry "pkg-config-deps" + (intercalate ", " . map (\(pn, mb_v) -> prettyShow pn ++ + case mb_v of + Nothing -> "" + Just v -> " " ++ prettyShow v) + . Set.toList) pkgHashPkgConfigDeps + , entry "deps" (intercalate ", " . map prettyShow + . Set.toList) pkgHashDirectDeps + -- and then all the config + , entry "compilerid" prettyShow pkgHashCompilerId + , entry "platform" prettyShow pkgHashPlatform + , opt "flags" mempty showFlagAssignment pkgHashFlagAssignment + , opt "configure-script" [] unwords pkgHashConfigureScriptArgs + , opt "vanilla-lib" True prettyShow pkgHashVanillaLib + , opt "shared-lib" False prettyShow pkgHashSharedLib + , opt "dynamic-exe" False prettyShow pkgHashDynExe + , opt "fully-static-exe" False prettyShow pkgHashFullyStaticExe + , opt "ghci-lib" False prettyShow pkgHashGHCiLib + , opt "prof-lib" False prettyShow pkgHashProfLib + , opt "prof-exe" False prettyShow pkgHashProfExe + , opt "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail + , opt "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail + , opt "hpc" False prettyShow pkgHashCoverage + , opt "optimisation" NormalOptimisation (show . fromEnum) pkgHashOptimization + , opt "split-objs" False prettyShow pkgHashSplitObjs + , opt "split-sections" False prettyShow pkgHashSplitSections + , opt "stripped-lib" False prettyShow pkgHashStripLibs + , opt "stripped-exe" True prettyShow pkgHashStripExes + , opt "debug-info" NormalDebugInfo (show . fromEnum) pkgHashDebugInfo + , opt "extra-lib-dirs" [] unwords pkgHashExtraLibDirs + , opt "extra-lib-dirs-static" [] unwords pkgHashExtraLibDirsStatic + , opt "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs + , opt "extra-include-dirs" [] unwords pkgHashExtraIncludeDirs + , opt "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix + , opt "prog-suffix" Nothing (maybe "" fromPathTemplate) pkgHashProgSuffix + , opt "package-dbs" [] (unwords . map show) pkgHashPackageDbs + + ] ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs + where + entry key format value = Just (key ++ ": " ++ format value) + mentry key format value = fmap (\v -> key ++ ": " ++ format v) value + opt key def format value + | value == def = Nothing + | otherwise = entry key format value ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -486,16 +486,14 @@ generateConfigHs = do trackGenerateHs cProjectName <- getSetting ProjectName cBooterVersion <- getSetting GhcVersion - cProjectVersionMunged <- getSetting ProjectVersionMunged - -- ROMES:TODO:HASH First we attempt a fixed unit-id with version but without hash. - -- - -- We now use a more informative unit-id for ghc. See Note [GHC's Unit Id] - -- in GHC.Unit.Types + -- We now give a unit-id with a version and a hash to ghc. + -- See Note [GHC's Unit Id] in GHC.Unit.Types -- -- It's crucial that the unit-id matches the unit-key -- ghc is no longer -- part of the WiringMap, so we don't to go back and forth between the - -- unit-id and the unit-key -- we take care here that they are the same. - let cProjectUnitId = "ghc-" ++ cProjectVersionMunged -- ROMES:TODO:HASH + -- unit-id and the unit-key -- we take care that they are the same by using + -- 'pkgUnitId' to create the unit-id in both situations. + cProjectUnitId <- pkgUnitId <$> getPackage return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -592,3 +590,4 @@ generatePlatformHostHs = do , "hostPlatformArchOS :: ArchOS" , "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS" ] + ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -243,6 +243,8 @@ wayGhcArgs = do , (way == debug || way == debugDynamic) ? pure ["-ticky", "-DTICKY_TICKY"] ] +-- | Args related to correct handling of packages, such as setting +-- -this-unit-id and passing -package-id for dependencies packageGhcArgs :: Args packageGhcArgs = do package <- getPackage @@ -251,13 +253,13 @@ packageGhcArgs = do -- unit-id to be "ghc", the stage0 compiler must be built -- with `-this-unit-id ghc`, while the wired-in unit-id of -- ghc is correctly set to the unit-id we'll generate for - -- stage1 (set in generateVersionHs in Rules.Generate). + -- stage1 (set in generateConfigHs in Rules.Generate). -- -- However, we don't need to set the unit-id of "ghc" to "ghc" when -- building stage0 because we have a flag in compiler/ghc.cabal.in that is -- sets `-this-unit-id ghc` when hadrian is building stage0, which will -- overwrite this one. - pkgId <- expr $ pkgIdentifier package + pkgId <- expr $ pkgUnitId package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/848c2265e8ae73176b8da9065595992a0c60e640 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/848c2265e8ae73176b8da9065595992a0c60e640 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 11:39:59 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Thu, 16 Mar 2023 07:39:59 -0400 Subject: [Git][ghc/ghc][wip/interface-loading-errs] 3 commits: Convert interface file loading errors into proper diagnostics Message-ID: <6413000fdde3_37e76b358068c8448530@gitlab.mail> sheaf pushed to branch wip/interface-loading-errs at Glasgow Haskell Compiler / GHC Commits: 65e873fe by Matthew Pickering at 2023-03-16T12:39:17+01:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the MissingInterfaceErrors into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the MissingInterfaceError This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the TcR - - - - - a2c01839 by Matthew Pickering at 2023-03-16T12:39:17+01:00 wip - - - - - 53cb7758 by sheaf at 2023-03-16T12:39:17+01:00 refactor interface error datatypes - - - - - 26 changed files: - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Tidy.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/Error.hs - ghc/GHCi/UI.hs - + ghc/GHCi/UI/Exception.hs - ghc/Main.hs - ghc/ghc-bin.cabal.in Changes: ===================================== compiler/GHC/Driver/Config/Diagnostic.hs ===================================== @@ -13,6 +13,7 @@ where import GHC.Driver.Flags import GHC.Driver.Session +import GHC.Prelude import GHC.Utils.Outputable import GHC.Utils.Error (DiagOpts (..)) @@ -48,7 +49,9 @@ initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage initPsMessageOpts _ = NoDiagnosticOpts initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage -initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags } +initTcMessageOpts dflags = + TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags + , tcOptsShowTriedFiles = verbosity dflags >= 3 } initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage initDsMessageOpts _ = NoDiagnosticOpts ===================================== compiler/GHC/Driver/Config/Tidy.hs ===================================== @@ -26,6 +26,9 @@ import GHC.Types.TyThing import GHC.Platform.Ways import qualified GHC.LanguageExtensions as LangExt +import GHC.Types.Error +import GHC.Utils.Error +import GHC.Driver.Config.Diagnostic (initTcMessageOpts) initTidyOpts :: HscEnv -> IO TidyOpts initTidyOpts hsc_env = do @@ -51,7 +54,10 @@ initStaticPtrOpts hsc_env = do let lookupM n = lookupGlobal_maybe hsc_env n >>= \case Succeeded r -> pure r - Failed err -> pprPanic "initStaticPtrOpts: couldn't find" (ppr (err,n)) + Failed err -> + let txt = formatBulleted $ diagnosticMessage (initTcMessageOpts dflags) err + in pprPanic "initStaticPtrOpts: couldn't find" (ppr (txt, n)) + mk_string <- getMkStringIds (fmap tyThingId . lookupM) static_ptr_info_datacon <- tyThingDataCon <$> lookupM staticPtrInfoDataConName ===================================== compiler/GHC/Driver/Errors.hs ===================================== @@ -13,7 +13,7 @@ import GHC.Types.SrcLoc import GHC.Types.SourceError import GHC.Types.Error import GHC.Utils.Error -import GHC.Utils.Outputable (hang, ppr, ($$), SDocContext, text, withPprStyle, mkErrStyle, sdocStyle ) +import GHC.Utils.Outputable (hang, ppr, ($$), text, mkErrStyle, sdocStyle, updSDocContext ) import GHC.Utils.Logger import qualified GHC.Driver.CmdLine as CmdLine @@ -22,21 +22,21 @@ printMessages logger msg_opts opts msgs = sequence_ [ let style = mkErrStyle name_ppr_ctx ctx = (diag_ppr_ctx opts) { sdocStyle = style } in logMsg logger (MCDiagnostic sev (diagnosticReason dia) (diagnosticCode dia)) s $ - withPprStyle style (messageWithHints ctx dia) + updSDocContext (\_ -> ctx) (messageWithHints dia) | MsgEnvelope { errMsgSpan = s, errMsgDiagnostic = dia, errMsgSeverity = sev, errMsgContext = name_ppr_ctx } <- sortMsgBag (Just opts) (getMessages msgs) ] where - messageWithHints :: Diagnostic a => SDocContext -> a -> SDoc - messageWithHints ctx e = - let main_msg = formatBulleted ctx $ diagnosticMessage msg_opts e + messageWithHints :: Diagnostic a => a -> SDoc + messageWithHints e = + let main_msg = formatBulleted $ diagnosticMessage msg_opts e in case diagnosticHints e of [] -> main_msg [h] -> main_msg $$ hang (text "Suggested fix:") 2 (ppr h) hs -> main_msg $$ hang (text "Suggested fixes:") 2 - (formatBulleted ctx . mkDecorated . map ppr $ hs) + (formatBulleted $ mkDecorated . map ppr $ hs) handleFlagWarnings :: Logger -> GhcMessageOpts -> DiagOpts -> [CmdLine.Warn] -> IO () handleFlagWarnings logger print_config opts warns = do ===================================== compiler/GHC/Driver/Errors/Ppr.hs ===================================== @@ -16,7 +16,7 @@ import GHC.Driver.Flags import GHC.Driver.Session import GHC.HsToCore.Errors.Ppr () import GHC.Parser.Errors.Ppr () -import GHC.Tc.Errors.Ppr () +import GHC.Tc.Errors.Ppr import GHC.Types.Error import GHC.Types.Error.Codes ( constructorCode ) import GHC.Unit.Types @@ -28,7 +28,7 @@ import GHC.Types.SrcLoc import Data.Version import Language.Haskell.Syntax.Decls (RuleDecl(..)) -import GHC.Tc.Errors.Types (TcRnMessage) +import GHC.Tc.Errors.Types (TcRnMessage, BuildingCabalPackage (..)) import GHC.HsToCore.Errors.Types (DsMessage) -- @@ -218,6 +218,8 @@ instance Diagnostic DriverMessage where -> mkSimpleDecorated $ vcat ([text "Home units are not closed." , text "It is necessary to also load the following units:" ] ++ map (\uid -> text "-" <+> ppr uid) needed_unit_ids) + DriverInterfaceError reason -> + mkSimpleDecorated $ missingInterfaceErrorDiagnostic False reason diagnosticReason = \case DriverUnknownMessage m @@ -272,6 +274,7 @@ instance Diagnostic DriverMessage where -> ErrorWithoutFlag DriverHomePackagesNotClosed {} -> ErrorWithoutFlag + DriverInterfaceError reason -> missingInterfaceErrorReason reason diagnosticHints = \case DriverUnknownMessage m @@ -328,5 +331,6 @@ instance Diagnostic DriverMessage where -> noHints DriverHomePackagesNotClosed {} -> noHints + DriverInterfaceError reason -> missingInterfaceErrorHints reason diagnosticCode = constructorCode ===================================== compiler/GHC/Driver/Errors/Types.hs ===================================== @@ -8,7 +8,6 @@ module GHC.Driver.Errors.Types ( , DriverMessage(..) , DriverMessageOpts(..) , DriverMessages, PsMessage(PsHeaderMessage) - , BuildingCabalPackage(..) , WarningMessages , ErrorMessages , WarnMsg @@ -31,7 +30,6 @@ import GHC.Unit.Module import GHC.Unit.State import GHC.Parser.Errors.Types ( PsMessage(PsHeaderMessage) ) -import GHC.Tc.Errors.Types ( TcRnMessage ) import GHC.HsToCore.Errors.Types ( DsMessage ) import GHC.Hs.Extension (GhcTc) @@ -39,6 +37,8 @@ import Language.Haskell.Syntax.Decls (RuleDecl) import GHC.Generics ( Generic ) +import GHC.Tc.Errors.Types + -- | A collection of warning messages. -- /INVARIANT/: Each 'GhcMessage' in the collection should have 'SevWarning' severity. type WarningMessages = Messages GhcMessage @@ -368,21 +368,17 @@ data DriverMessage where DriverHomePackagesNotClosed :: ![UnitId] -> DriverMessage + DriverInterfaceError :: MissingInterfaceError -> DriverMessage + deriving instance Generic DriverMessage data DriverMessageOpts = DriverMessageOpts { psDiagnosticOpts :: DiagnosticOpts PsMessage } --- | Pass to a 'DriverMessage' the information whether or not the --- '-fbuilding-cabal-package' flag is set. -data BuildingCabalPackage - = YesBuildingCabalPackage - | NoBuildingCabalPackage - deriving Eq -- | Checks if we are building a cabal package by consulting the 'DynFlags'. checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage checkBuildingCabalPackage dflags = if gopt Opt_BuildingCabalPackage dflags then YesBuildingCabalPackage - else NoBuildingCabalPackage + else NoBuildingCabalPackage \ No newline at end of file ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -2330,7 +2330,7 @@ noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMe -- ToDo: we don't have a proper line number for this error noModError hsc_env loc wanted_mod err = mkPlainErrorMsgEnvelope loc $ GhcDriverMessage $ - DriverUnknownMessage $ UnknownDiagnostic $ mkPlainError noHints $ + DriverInterfaceError $ cannotFindModule hsc_env wanted_mod err {- ===================================== compiler/GHC/Driver/MakeFile.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Data.Graph.Directed ( SCC(..) ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain -import GHC.Types.Error (UnknownDiagnostic(..)) import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Types.PkgQual @@ -307,8 +306,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do fail -> throwOneError $ mkPlainErrorMsgEnvelope srcloc $ - GhcDriverMessage $ DriverUnknownMessage $ - UnknownDiagnostic $ mkPlainError noHints $ + GhcDriverMessage $ DriverInterfaceError $ cannotFindModule hsc_env imp fail ----------------------------- ===================================== compiler/GHC/Iface/Errors.hs ===================================== @@ -3,14 +3,9 @@ module GHC.Iface.Errors ( badIfaceFile - , hiModuleNameMismatchWarn - , homeModError , cannotFindInterface , cantFindInstalledErr , cannotFindModule - , cantFindErr - -- * Utility functions - , mayShowLocations ) where import GHC.Platform.Profile @@ -21,77 +16,45 @@ import GHC.Driver.Env import GHC.Driver.Errors.Types import GHC.Data.Maybe import GHC.Prelude +import GHC.Tc.Errors.Types import GHC.Unit import GHC.Unit.Env import GHC.Unit.Finder.Types import GHC.Utils.Outputable as Outputable +-- ----------------------------------------------------------------------------- +-- Error messages badIfaceFile :: String -> SDoc -> SDoc badIfaceFile file err = vcat [text "Bad interface file:" <+> text file, nest 4 err] -hiModuleNameMismatchWarn :: Module -> Module -> SDoc -hiModuleNameMismatchWarn requested_mod read_mod - | moduleUnit requested_mod == moduleUnit read_mod = - sep [text "Interface file contains module" <+> quotes (ppr read_mod) <> comma, - text "but we were expecting module" <+> quotes (ppr requested_mod), - sep [text "Probable cause: the source code which generated interface file", - text "has an incompatible module name" - ] - ] - | otherwise = - -- ToDo: This will fail to have enough qualification when the package IDs - -- are the same - withPprStyle (mkUserStyle alwaysQualify AllTheWay) $ - -- we want the Modules below to be qualified with package names, - -- so reset the NamePprCtx setting. - hsep [ text "Something is amiss; requested module " - , ppr requested_mod - , text "differs from name found in the interface file" - , ppr read_mod - , parens (text "if these names look the same, try again with -dppr-debug") - ] - -homeModError :: InstalledModule -> ModLocation -> SDoc --- See Note [Home module load error] -homeModError mod location - = text "attempting to use module " <> quotes (ppr mod) - <> (case ml_hs_file location of - Just file -> space <> parens (text file) - Nothing -> Outputable.empty) - <+> text "which is not loaded" - - --- ----------------------------------------------------------------------------- --- Error messages - -cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc -cannotFindInterface = cantFindInstalledErr (text "Failed to load interface for") - (text "Ambiguous interface for") +cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile + -> ModuleName -> InstalledFindResult -> MissingInterfaceError +cannotFindInterface us mhu p mn ifr = + CantFindInstalledErr $ + cantFindInstalledErr CantLoadInterface + AmbiguousInterface us mhu p mn ifr cantFindInstalledErr - :: SDoc - -> SDoc + :: CantFindWhat + -> CantFindWhat -> UnitState -> Maybe HomeUnit -> Profile - -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult - -> SDoc -cantFindInstalledErr cannot_find _ unit_state mhome_unit profile tried_these mod_name find_result - = cannot_find <+> quotes (ppr mod_name) - $$ more_info + -> CantFindInstalled +cantFindInstalledErr cannot_find _ unit_state mhome_unit profile mod_name find_result + = CantFindInstalled mod_name cannot_find more_info where build_tag = waysBuildTag (profileWays profile) more_info = case find_result of InstalledNoPackage pkg - -> text "no unit id matching" <+> quotes (ppr pkg) <+> - text "was found" $$ looks_like_srcpkgid pkg + -> NoUnitIdMatching pkg (searchPackageId unit_state (PackageId (unitIdFS pkg))) InstalledNotFound files mb_pkg | Just pkg <- mb_pkg @@ -99,65 +62,41 @@ cantFindInstalledErr cannot_find _ unit_state mhome_unit profile tried_these mod -> not_found_in_package pkg files | null files - -> text "It is not a module in the current program, or in any known package." + -> NotAModule | otherwise - -> tried_these files + -> CouldntFindInFiles files _ -> panic "cantFindInstalledErr" - looks_like_srcpkgid :: UnitId -> SDoc - looks_like_srcpkgid pk - -- Unsafely coerce a unit id (i.e. an installed package component - -- identifier) into a PackageId and see if it means anything. - | (pkg:pkgs) <- searchPackageId unit_state (PackageId (unitIdFS pk)) - = parens (text "This unit ID looks like the source package ID;" $$ - text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$ - (if null pkgs then Outputable.empty - else text "and" <+> int (length pkgs) <+> text "other candidates")) - -- Todo: also check if it looks like a package name! - | otherwise = Outputable.empty - not_found_in_package pkg files | build_tag /= "" = let build = if build_tag == "p" then "profiling" else "\"" ++ build_tag ++ "\"" in - text "Perhaps you haven't installed the " <> text build <> - text " libraries for package " <> quotes (ppr pkg) <> char '?' $$ - tried_these files - + MissingPackageWayFiles build pkg files | otherwise - = text "There are files missing in the " <> quotes (ppr pkg) <> - text " package," $$ - text "try running 'ghc-pkg check'." $$ - tried_these files + = MissingPackageFiles pkg files + -mayShowLocations :: DynFlags -> [FilePath] -> SDoc -mayShowLocations dflags files - | null files = Outputable.empty - | verbosity dflags < 3 = - text "Use -v (or `:set -v` in ghci) " <> - text "to see a list of the files searched for." - | otherwise = - hang (text "Locations searched:") 2 $ vcat (map text files) -cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc +cannotFindModule :: HscEnv -> ModuleName -> FindResult -> MissingInterfaceError cannotFindModule hsc_env = cannotFindModule' (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (targetProfile (hsc_dflags hsc_env)) -cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc -cannotFindModule' dflags unit_env profile mod res = pprWithUnitState (ue_units unit_env) $ +cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult + -> MissingInterfaceError +cannotFindModule' dflags unit_env profile mod res = + CantFindErr (ue_units unit_env) $ cantFindErr (checkBuildingCabalPackage dflags) cannotFindMsg - (text "Ambiguous module name") + AmbiguousModule unit_env profile - (mayShowLocations dflags) mod res where @@ -167,84 +106,52 @@ cannotFindModule' dflags unit_env profile mod res = pprWithUnitState (ue_units u , fr_pkgs_hidden = hidden_pkgs , fr_unusables = unusables } | not (null hidden_mods && null hidden_pkgs && null unusables) - -> text "Could not load module" - _ -> text "Could not find module" + -> CantLoadModule + _ -> CantFindModule cantFindErr :: BuildingCabalPackage -- ^ Using Cabal? - -> SDoc - -> SDoc + -> CantFindWhat + -> CantFindWhat -> UnitEnv -> Profile - -> ([FilePath] -> SDoc) -> ModuleName -> FindResult - -> SDoc -cantFindErr _ _ multiple_found _ _ _ mod_name (FoundMultiple mods) - | Just pkgs <- unambiguousPackages - = hang (multiple_found <+> quotes (ppr mod_name) <> colon) 2 ( - sep [text "it was found in multiple packages:", - hsep (map ppr pkgs) ] - ) - | otherwise - = hang (multiple_found <+> quotes (ppr mod_name) <> colon) 2 ( - vcat (map pprMod mods) - ) - where - unambiguousPackages = foldl' unambiguousPackage (Just []) mods - unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) - = Just (moduleUnit m : xs) - unambiguousPackage _ _ = Nothing + -> CantFindInstalled +cantFindErr _ _ multiple_found _ _ mod_name (FoundMultiple mods) + = CantFindInstalled mod_name multiple_found (MultiplePackages mods) - pprMod (m, o) = text "it is bound as" <+> ppr m <+> - text "by" <+> pprOrigin m o - pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden" - pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable" - pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma ( - if e == Just True - then [text "package" <+> ppr (moduleUnit m)] - else [] ++ - map ((text "a reexport in package" <+>) - .ppr.mkUnit) res ++ - if f then [text "a package flag"] else [] - ) - -cantFindErr using_cabal cannot_find _ unit_env profile tried_these mod_name find_result - = cannot_find <+> quotes (ppr mod_name) - $$ more_info +cantFindErr using_cabal cannot_find _ unit_env profile mod_name find_result + = CantFindInstalled mod_name cannot_find more_info where mhome_unit = ue_homeUnit unit_env more_info = case find_result of NoPackage pkg - -> text "no unit id matching" <+> quotes (ppr pkg) <+> - text "was found" - + -> NoUnitIdMatching (toUnitId pkg) [] NotFound { fr_paths = files, fr_pkg = mb_pkg , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens , fr_unusables = unusables, fr_suggestions = suggest } | Just pkg <- mb_pkg , Nothing <- mhome_unit -- no home-unit - -> not_found_in_package pkg files + -> not_found_in_package (toUnitId pkg) files | Just pkg <- mb_pkg , Just home_unit <- mhome_unit -- there is a home-unit but the , not (isHomeUnit home_unit pkg) -- module isn't from it - -> not_found_in_package pkg files + -> not_found_in_package (toUnitId pkg) files | not (null suggest) - -> pp_suggestions suggest $$ tried_these files + -> ModuleSuggestion suggest files | null files && null mod_hiddens && null pkg_hiddens && null unusables - -> text "It is not a module in the current program, or in any known package." + -> NotAModule | otherwise - -> vcat (map pkg_hidden pkg_hiddens) $$ - vcat (map mod_hidden mod_hiddens) $$ - vcat (map unusable unusables) $$ - tried_these files - + -> GenericMissing using_cabal + (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) + mod_hiddens unusables files _ -> panic "cantFindErr" build_tag = waysBuildTag (profileWays profile) @@ -255,81 +162,7 @@ cantFindErr using_cabal cannot_find _ unit_env profile tried_these mod_name find build = if build_tag == "p" then "profiling" else "\"" ++ build_tag ++ "\"" in - text "Perhaps you haven't installed the " <> text build <> - text " libraries for package " <> quotes (ppr pkg) <> char '?' $$ - tried_these files + MissingPackageWayFiles build pkg files | otherwise - = text "There are files missing in the " <> quotes (ppr pkg) <> - text " package," $$ - text "try running 'ghc-pkg check'." $$ - tried_these files - - pkg_hidden :: Unit -> SDoc - pkg_hidden uid = - text "It is a member of the hidden package" - <+> quotes (ppr uid) - --FIXME: we don't really want to show the unit id here we should - -- show the source package id or installed package id if it's ambiguous - <> dot $$ pkg_hidden_hint uid - - pkg_hidden_hint uid - | using_cabal == YesBuildingCabalPackage - = let pkg = expectJust "pkg_hidden" (lookupUnit (ue_units unit_env) uid) - in text "Perhaps you need to add" <+> - quotes (ppr (unitPackageName pkg)) <+> - text "to the build-depends in your .cabal file." - | Just pkg <- lookupUnit (ue_units unit_env) uid - = text "You can run" <+> - quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> - text "to expose it." $$ - text "(Note: this unloads all the modules in the current scope.)" - | otherwise = Outputable.empty - - mod_hidden pkg = - text "it is a hidden module in the package" <+> quotes (ppr pkg) - - unusable (pkg, reason) - = text "It is a member of the package" - <+> quotes (ppr pkg) - $$ pprReason (text "which is") reason - - pp_suggestions :: [ModuleSuggestion] -> SDoc - pp_suggestions sugs - | null sugs = Outputable.empty - | otherwise = hang (text "Perhaps you meant") - 2 (vcat (map pp_sugg sugs)) - - -- NB: Prefer the *original* location, and then reexports, and then - -- package flags when making suggestions. ToDo: if the original package - -- also has a reexport, prefer that one - pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o - where provenance ModHidden = Outputable.empty - provenance (ModUnusable _) = Outputable.empty - provenance (ModOrigin{ fromOrigUnit = e, - fromExposedReexport = res, - fromPackageFlag = f }) - | Just True <- e - = parens (text "from" <+> ppr (moduleUnit mod)) - | f && moduleName mod == m - = parens (text "from" <+> ppr (moduleUnit mod)) - | (pkg:_) <- res - = parens (text "from" <+> ppr (mkUnit pkg) - <> comma <+> text "reexporting" <+> ppr mod) - | f - = parens (text "defined via package flags to be" - <+> ppr mod) - | otherwise = Outputable.empty - pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o - where provenance ModHidden = Outputable.empty - provenance (ModUnusable _) = Outputable.empty - provenance (ModOrigin{ fromOrigUnit = e, - fromHiddenReexport = rhs }) - | Just False <- e - = parens (text "needs flag -package-id" - <+> ppr (moduleUnit mod)) - | (pkg:_) <- rhs - = parens (text "needs flag -package-id" - <+> ppr (mkUnit pkg)) - | otherwise = Outputable.empty - + = MissingPackageFiles pkg files ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -143,7 +143,7 @@ where the code that e1 expands to might import some defns that also turn out to be needed by the code that e2 expands to. -} -tcLookupImported_maybe :: Name -> TcM (MaybeErr SDoc TyThing) +tcLookupImported_maybe :: Name -> TcM (MaybeErr InterfaceError TyThing) -- Returns (Failed err) if we can't find the interface file for the thing tcLookupImported_maybe name = do { hsc_env <- getTopEnv @@ -152,7 +152,7 @@ tcLookupImported_maybe name Just thing -> return (Succeeded thing) Nothing -> tcImportDecl_maybe name } -tcImportDecl_maybe :: Name -> TcM (MaybeErr SDoc TyThing) +tcImportDecl_maybe :: Name -> TcM (MaybeErr InterfaceError TyThing) -- Entry point for *source-code* uses of importDecl tcImportDecl_maybe name | Just thing <- wiredInNameTyThing_maybe name @@ -163,7 +163,7 @@ tcImportDecl_maybe name | otherwise = initIfaceTcRn (importDecl name) -importDecl :: Name -> IfM lcl (MaybeErr SDoc TyThing) +importDecl :: Name -> IfM lcl (MaybeErr InterfaceError TyThing) -- Get the TyThing for this Name from an interface file -- It's not a wired-in thing -- the caller caught that importDecl name @@ -174,29 +174,22 @@ importDecl name -- Load the interface, which should populate the PTE ; mb_iface <- assertPpr (isExternalName name) (ppr name) $ loadInterface nd_doc (nameModule name) ImportBySystem - ; case mb_iface of { - Failed err_msg -> return (Failed err_msg) ; - Succeeded _ -> do + ; case mb_iface of + { Failed err_msg -> return $ Failed $ + Can'tFindInterface err_msg (LookingForName name) + ; Succeeded _ -> do -- Now look it up again; this time we should find it { eps <- getEps ; case lookupTypeEnv (eps_PTE eps) name of Just thing -> return $ Succeeded thing - Nothing -> let doc = whenPprDebug (found_things_msg eps $$ empty) - $$ not_found_msg - in return $ Failed doc + Nothing -> return $ Failed $ + Can'tFindNameInInterface name + (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps) }}} where nd_doc = text "Need decl for" <+> ppr name - not_found_msg = hang (text "Can't find interface-file declaration for" <+> - pprNameSpace (nameNameSpace name) <+> ppr name) - 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", - text "Use -ddump-if-trace to get an idea of which file caused the error"]) - found_things_msg eps = - hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon) - 2 (vcat (map ppr $ filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps)) - where - is_interesting thing = nameModule name == nameModule (getName thing) + is_interesting thing = nameModule name == nameModule (getName thing) {- @@ -299,15 +292,21 @@ loadSrcInterface :: SDoc loadSrcInterface doc mod want_boot maybe_pkg = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg ; case res of - Failed err -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints err) - Succeeded iface -> return iface } + Failed err -> + failWithTc $ + TcRnInterfaceError $ + Can'tFindInterface err $ + LookingForModule mod want_boot + Succeeded iface -> + return iface + } -- | Like 'loadSrcInterface', but returns a 'MaybeErr'. loadSrcInterface_maybe :: SDoc -> ModuleName -> IsBootInterface -- {-# SOURCE #-} ? -> PkgQual -- "package", if any - -> RnM (MaybeErr SDoc ModIface) + -> RnM (MaybeErr MissingInterfaceError ModIface) loadSrcInterface_maybe doc mod want_boot maybe_pkg -- We must first find which Module this import refers to. This involves @@ -403,11 +402,11 @@ loadInterfaceWithException doc mod_name where_from = do dflags <- getDynFlags let ctx = initSDocContext dflags defaultUserStyle - withException ctx (loadInterface doc mod_name where_from) + withIfaceErr ctx (loadInterface doc mod_name where_from) ------------------ loadInterface :: SDoc -> Module -> WhereFrom - -> IfM lcl (MaybeErr SDoc ModIface) + -> IfM lcl (MaybeErr MissingInterfaceError ModIface) -- loadInterface looks in both the HPT and PIT for the required interface -- If not found, it loads it, and puts it in the PIT (always). @@ -703,7 +702,7 @@ computeInterface -> SDoc -> IsBootInterface -> Module - -> IO (MaybeErr SDoc (ModIface, FilePath)) + -> IO (MaybeErr MissingInterfaceError (ModIface, FilePath)) computeInterface hsc_env doc_str hi_boot_file mod0 = do massert (not (isHoleModule mod0)) let mhome_unit = hsc_home_unit_maybe hsc_env @@ -732,7 +731,7 @@ computeInterface hsc_env doc_str hi_boot_file mod0 = do -- @p[A=\,B=\]:B@ never includes B. moduleFreeHolesPrecise :: SDoc -> Module - -> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName)) + -> TcRnIf gbl lcl (MaybeErr MissingInterfaceError (UniqDSet ModuleName)) moduleFreeHolesPrecise doc_str mod | moduleIsDefinite mod = return (Succeeded emptyUniqDSet) | otherwise = @@ -769,13 +768,13 @@ moduleFreeHolesPrecise doc_str mod Failed err -> return (Failed err) wantHiBootFile :: Maybe HomeUnit -> ExternalPackageState -> Module -> WhereFrom - -> MaybeErr SDoc IsBootInterface + -> MaybeErr MissingInterfaceError IsBootInterface -- Figure out whether we want Foo.hi or Foo.hi-boot wantHiBootFile mhome_unit eps mod from = case from of ImportByUser usr_boot | usr_boot == IsBoot && notHomeModuleMaybe mhome_unit mod - -> Failed (badSourceImport mod) + -> Failed (BadSourceImport mod) | otherwise -> Succeeded usr_boot ImportByPlugin @@ -798,11 +797,6 @@ wantHiBootFile mhome_unit eps mod from -- The boot-ness of the requested interface, -- based on the dependencies in directly-imported modules -badSourceImport :: Module -> SDoc -badSourceImport mod - = hang (text "You cannot {-# SOURCE #-} import a module from another package") - 2 (text "but" <+> quotes (ppr mod) <+> text "is from package" - <+> quotes (ppr (moduleUnit mod))) ----------------------------------------------------- -- Loading type/class/value decls @@ -855,7 +849,7 @@ findAndReadIface -- this to check the consistency of the requirements of the -- module we read out. -> IsBootInterface -- ^ Looking for .hi-boot or .hi file - -> IO (MaybeErr SDoc (ModIface, FilePath)) + -> IO (MaybeErr MissingInterfaceError (ModIface, FilePath)) findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do let profile = targetProfile dflags @@ -897,12 +891,12 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do Just home_unit | isHomeInstalledModule home_unit mod , not (isOneShot (ghcMode dflags)) - -> return (Failed (homeModError mod loc)) + -> return (Failed (HomeModError mod loc)) _ -> do r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc) case r of - Failed _ - -> return r + Failed err + -> return (Failed $ BadIfaceFile err) Succeeded (iface,_fp) -> do r2 <- load_dynamic_too_maybe logger name_cache unit_state @@ -910,46 +904,47 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do iface loc case r2 of Failed sdoc -> return (Failed sdoc) - Succeeded {} -> return r + Succeeded {} -> return $ Succeeded (iface,_fp) err -> do trace_if logger (text "...not found") return $ Failed $ cannotFindInterface unit_state mhome_unit profile - (Iface_Errors.mayShowLocations dflags) (moduleName mod) err -- | Check if we need to try the dynamic interface for -dynamic-too -load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr SDoc ()) +load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> ModIface -> ModLocation + -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc -- Indefinite interfaces are ALWAYS non-dynamic. | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ()) | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc | otherwise = return (Succeeded ()) -load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr SDoc ()) +load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> ModIface -> ModLocation + -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case Succeeded (dynIface, _) | mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface) -> return (Succeeded ()) | otherwise -> - do return $ (Failed $ dynamicHashMismatchError wanted_mod loc) + do return $ (Failed $ DynamicHashMismatchError wanted_mod loc) Failed err -> - do return $ (Failed $ ((text "Failed to load dynamic interface file for" <+> ppr wanted_mod <> colon) $$ err)) + do return $ (Failed $ FailedToLoadDynamicInterface wanted_mod err) + --((text "Failed to load dynamic interface file for" <+> ppr wanted_mod <> colon) $$ err)) -dynamicHashMismatchError :: Module -> ModLocation -> SDoc -dynamicHashMismatchError wanted_mod loc = - vcat [ text "Dynamic hash doesn't match for" <+> quotes (ppr wanted_mod) - , text "Normal interface file from" <+> text (ml_hi_file loc) - , text "Dynamic interface file from" <+> text (ml_dyn_hi_file loc) - , text "You probably need to recompile" <+> quotes (ppr wanted_mod) ] -read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr SDoc (ModIface, FilePath)) + +read_file :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> FilePath + -> IO (MaybeErr ReadInterfaceError (ModIface, FilePath)) read_file logger name_cache unit_state dflags wanted_mod file_path = do trace_if logger (text "readIFace" <+> text file_path) @@ -964,7 +959,7 @@ read_file logger name_cache unit_state dflags wanted_mod file_path = do (uninstantiateInstantiatedModule indef_mod) read_result <- readIface dflags name_cache wanted_mod' file_path case read_result of - Failed err -> return (Failed (badIfaceFile file_path err)) + Failed err -> return (Failed err) Succeeded iface -> return (Succeeded (iface, file_path)) -- Don't forget to fill in the package name... @@ -985,7 +980,7 @@ readIface -> NameCache -> Module -> FilePath - -> IO (MaybeErr SDoc ModIface) + -> IO (MaybeErr ReadInterfaceError ModIface) readIface dflags name_cache wanted_mod file_path = do let profile = targetProfile dflags res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path @@ -999,9 +994,9 @@ readIface dflags name_cache wanted_mod file_path = do | otherwise -> return (Failed err) where actual_mod = mi_module iface - err = hiModuleNameMismatchWarn wanted_mod actual_mod + err = HiModuleNameMismatchWarn file_path wanted_mod actual_mod - Left exn -> return (Failed (text (showException exn))) + Left exn -> return (Failed (ExceptionOccurred file_path exn)) {- ********************************************************* ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Iface.Recomp.Flags import GHC.Iface.Env import GHC.Core +import GHC.Tc.Errors.Ppr import GHC.Tc.Utils.Monad import GHC.Hs @@ -292,8 +293,13 @@ check_old_iface hsc_env mod_summary maybe_iface read_result <- readIface read_dflags ncu (ms_mod mod_summary) iface_path case read_result of Failed err -> do - trace_if logger (text "FYI: cannot read old interface file:" $$ nest 4 err) - trace_hi_diffs logger (text "Old interface file was invalid:" $$ nest 4 err) + let msg = readInterfaceErrorDiagnostic err + trace_if logger + $ vcat [ text "FYI: cannot read old interface file:" + , nest 4 msg ] + trace_hi_diffs logger $ + vcat [ text "Old interface file was invalid:" + , nest 4 msg ] return Nothing Succeeded iface -> do trace_if logger (text "Read the interface file" <+> text iface_path) @@ -1319,7 +1325,7 @@ getOrphanHashes hsc_env mods = do dflags = hsc_dflags hsc_env ctx = initSDocContext dflags defaultUserStyle get_orph_hash mod = do - iface <- initIfaceLoad hsc_env . withException ctx + iface <- initIfaceLoad hsc_env . withIfaceErr ctx $ loadInterface (text "getOrphanHashes") mod ImportBySystem return (mi_orphan_hash (mi_final_exts iface)) @@ -1614,7 +1620,7 @@ mkHashFun hsc_env eps name -- requirements; we didn't do any /real/ typechecking -- so there's no guarantee everything is loaded. -- Kind of a heinous hack. - initIfaceLoad hsc_env . withException ctx + initIfaceLoad hsc_env . withIfaceErr ctx $ withoutDynamicNow -- If you try and load interfaces when dynamic-too -- enabled then it attempts to load the dyn_hi and hi ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -50,6 +50,7 @@ import GHC.StgToCmm.Types import GHC.Runtime.Heap.Layout import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Ppr import GHC.Tc.TyCl.Build import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType @@ -574,13 +575,14 @@ tcHiBootIface hsc_src mod -- to check consistency against, rather than just when we notice -- that an hi-boot is necessary due to a circular import. { hsc_env <- getTopEnv - ; read_result <- liftIO $ findAndReadIface hsc_env - need (fst (getModuleInstantiation mod)) mod - IsBoot -- Hi-boot file + ; read_result <- liftIO $ findAndReadIface hsc_env need + (fst (getModuleInstantiation mod)) mod + IsBoot -- Hi-boot file ; case read_result of { - Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface - ; mkSelfBootInfo iface tc_iface } ; + Succeeded (iface, _path) -> + do { tc_iface <- initIfaceTcRn $ typecheckIface iface + ; mkSelfBootInfo iface tc_iface } ; Failed err -> -- There was no hi-boot file. But if there is circularity in @@ -596,7 +598,10 @@ tcHiBootIface hsc_src mod Nothing -> return NoSelfBoot -- error cases Just (GWIB { gwib_isBoot = is_boot }) -> case is_boot of - IsBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints (elaborate err)) + IsBoot -> + let diag = Can'tFindInterface err + (LookingForHiBoot mod) + in failWithTc (TcRnInterfaceError diag) -- The hi-boot file has mysteriously disappeared. NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop) -- Someone below us imported us! @@ -609,8 +614,6 @@ tcHiBootIface hsc_src mod moduleLoop = text "Circular imports: module" <+> quotes (ppr mod) <+> text "depends on itself" - elaborate err = hang (text "Could not find hi-boot interface for" <+> - quotes (ppr mod) <> colon) 4 err mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo @@ -1961,7 +1964,7 @@ tcIfaceGlobal name { mb_thing <- importDecl name -- It's imported; go get it ; case mb_thing of - Failed err -> failIfM (ppr name <+> err) + Failed err -> failIfM (ppr name <+> interfaceErrorDiagnostic False err) Succeeded thing -> return thing }}} ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -48,6 +48,7 @@ import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Finder import GHC.Tc.Utils.Monad +import GHC.Tc.Errors.Ppr import GHC.Runtime.Interpreter import GHCi.RemoteTypes @@ -791,7 +792,10 @@ getLinkDeps hsc_env pls replace_osuf span mods mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $ loadInterface msg mod (ImportByUser NotBoot) iface <- case mb_iface of - Maybes.Failed err -> throwGhcExceptionIO (ProgramError (showSDoc dflags err)) + Maybes.Failed err -> + let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags + err_txt = missingInterfaceErrorDiagnostic tries err + in throwGhcExceptionIO (ProgramError (showSDoc dflags err_txt)) Maybes.Succeeded iface -> return iface when (mi_boot iface == IsBoot) $ link_boot_mod_error mod ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -44,6 +44,8 @@ import GHC.Core.Type ( Type, mkTyConTy ) import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( TyCon ) +import GHC.Tc.Errors.Ppr + import GHC.Types.SrcLoc ( noSrcSpan ) import GHC.Types.Name ( Name, nameModule_maybe ) import GHC.Types.Id ( idType ) @@ -52,11 +54,13 @@ import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS ) import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName , greMangledName, mkRdrQual ) +import GHC.Types.Unique.DFM import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) import GHC.Driver.Config.Finder ( initFinderOpts ) +import GHC.Driver.Config.Diagnostic ( initTcMessageOpts ) import GHC.Unit.Module ( Module, ModuleName ) -import GHC.Unit.Module.ModIface +import GHC.Unit.Module.ModIface ( ModIface_(mi_exports), ModIface ) import GHC.Unit.Env import GHC.Utils.Panic @@ -69,9 +73,9 @@ import Control.Monad ( unless ) import Data.Maybe ( mapMaybe ) import Unsafe.Coerce ( unsafeCoerce ) import GHC.Linker.Types -import GHC.Types.Unique.DFM import Data.List (unzip4) + -- | Loads the plugins specified in the pluginModNames field of the dynamic -- flags. Should be called after command line arguments are parsed, but before -- actual compilation starts. Idempotent operation. Should be re-called if @@ -328,7 +332,11 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do _ -> panic "lookupRdrNameInModule" Nothing -> throwCmdLineErrorS dflags $ hsep [text "Could not determine the exports of the module", ppr mod_name] - err -> throwCmdLineErrorS dflags $ cannotFindModule hsc_env mod_name err + err -> + let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags + err_txt = missingInterfaceErrorDiagnostic tries + $ cannotFindModule hsc_env mod_name err + in throwCmdLineErrorS dflags err_txt where doc = text "contains a name used in an invocation of lookupRdrNameInModule" ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -20,6 +20,14 @@ module GHC.Tc.Errors.Ppr , pprHsDocContext , inHsDocContext , TcRnMessageOpts(..) + + , interfaceErrorHints + , interfaceErrorReason + , interfaceErrorDiagnostic + , missingInterfaceErrorHints + , missingInterfaceErrorReason + , missingInterfaceErrorDiagnostic + , readInterfaceErrorDiagnostic ) where @@ -74,7 +82,7 @@ import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env -import GHC.Unit.State (pprWithUnitState, UnitState) +import GHC.Unit.State import GHC.Unit.Module import GHC.Unit.Module.Warnings ( pprWarningTxtForMsg ) @@ -101,10 +109,12 @@ import GHC.Types.Name.Env import qualified Language.Haskell.TH as TH data TcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext :: !Bool -- ^ Whether we show the error context or not + , tcOptsShowTriedFiles :: !Bool -- ^ Whether to show files we tried to look for or not when printing loader errors } defaultTcRnMessageOpts :: TcRnMessageOpts -defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext = True } +defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext = True + , tcOptsShowTriedFiles = False } instance Diagnostic TcRnMessage where @@ -1162,7 +1172,6 @@ instance Diagnostic TcRnMessage where True -> text (show item) False -> text (TH.pprint item)) TcRnReportCustomQuasiError _ msg -> mkSimpleDecorated $ text msg - TcRnInterfaceLookupError _ sdoc -> mkSimpleDecorated sdoc TcRnUnsatisfiedMinimalDef mindef -> mkSimpleDecorated $ vcat [text "No explicit implementation for" @@ -1406,6 +1415,12 @@ instance Diagnostic TcRnMessage where hsep [ text "Unknown type variable" <> plural errorVars , text "on the RHS of injectivity condition:" , interpp'SP errorVars ] + TcRnCan'tFindLocalName name + -> mkSimpleDecorated $ text "Can't find local name: " <+> ppr name + TcRnInterfaceError reason + -> mkSimpleDecorated $ + interfaceErrorDiagnostic (tcOptsShowTriedFiles opts) reason + diagnosticReason = \case TcRnUnknownMessage m @@ -1772,8 +1787,6 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnReportCustomQuasiError isError _ -> if isError then ErrorWithoutFlag else WarningWithoutFlag - TcRnInterfaceLookupError{} - -> ErrorWithoutFlag TcRnUnsatisfiedMinimalDef{} -> WarningWithFlag (Opt_WarnMissingMethods) TcRnMisplacedInstSig{} @@ -1870,6 +1883,11 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnUnknownTyVarsOnRhsOfInjCond{} -> ErrorWithoutFlag + TcRnCan'tFindLocalName {} + -> ErrorWithoutFlag + TcRnInterfaceError err + -> interfaceErrorReason err + diagnosticHints = \case TcRnUnknownMessage m @@ -2242,8 +2260,6 @@ instance Diagnostic TcRnMessage where -> noHints TcRnReportCustomQuasiError{} -> noHints - TcRnInterfaceLookupError{} - -> noHints TcRnUnsatisfiedMinimalDef{} -> noHints TcRnMisplacedInstSig{} @@ -2352,6 +2368,10 @@ instance Diagnostic TcRnMessage where -> noHints TcRnUnknownTyVarsOnRhsOfInjCond{} -> noHints + TcRnCan'tFindLocalName {} + -> noHints + TcRnInterfaceError reason + -> interfaceErrorHints reason diagnosticCode = constructorCode @@ -2366,6 +2386,297 @@ commafyWith conjunction xs = addConjunction $ punctuate comma xs addConjunction (x : xs) = x : addConjunction xs addConjunction _ = panic "commafyWith expected 2 or more elements" +interfaceErrorHints :: InterfaceError -> [GhcHint] +interfaceErrorHints = \ case + Can'tFindInterface err _looking_for -> + missingInterfaceErrorHints err + Can'tFindNameInInterface {} -> + noHints + +missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint] +missingInterfaceErrorHints = \case + BadSourceImport {} -> + noHints + HomeModError {} -> + noHints + DynamicHashMismatchError {} -> + noHints + CantFindErr {} -> + noHints + CantFindInstalledErr {} -> + noHints + BadIfaceFile {} -> + noHints + FailedToLoadDynamicInterface {} -> + noHints + +interfaceErrorReason :: InterfaceError -> DiagnosticReason +interfaceErrorReason (Can'tFindInterface err _) + = missingInterfaceErrorReason err +interfaceErrorReason (Can'tFindNameInInterface {}) + = ErrorWithoutFlag + +missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason +missingInterfaceErrorReason = \ case + BadSourceImport {} -> + ErrorWithoutFlag + HomeModError {} -> + ErrorWithoutFlag + DynamicHashMismatchError {} -> + ErrorWithoutFlag + CantFindErr {} -> + ErrorWithoutFlag + CantFindInstalledErr {} -> + ErrorWithoutFlag + BadIfaceFile {} -> + ErrorWithoutFlag + FailedToLoadDynamicInterface {} -> + ErrorWithoutFlag + +prettyCantFindWhat :: CantFindWhat -> (SDoc, SDoc) +prettyCantFindWhat CantFindModule = (text "Could not find module", dot) +prettyCantFindWhat CantLoadModule = (text "Could not load module", dot) +prettyCantFindWhat CantLoadInterface = (text "Failed to load interface for", colon) +prettyCantFindWhat AmbiguousModule = (text "Ambiguous module name", colon) +prettyCantFindWhat AmbiguousInterface= (text "Ambiguous interface for", colon) + +cantFindError :: Bool -> CantFindInstalled -> SDoc +cantFindError verbose (CantFindInstalled mod_name what cfir) = + let (ppr_what, punct) = prettyCantFindWhat what in + hang (ppr_what <+> quotes (ppr mod_name) <> punct) 4 $ + case cfir of + NoUnitIdMatching pkg cands -> + + let looks_like_srcpkgid :: SDoc + looks_like_srcpkgid = + -- Unsafely coerce a unit id (i.e. an installed package component + -- identifier) into a PackageId and see if it means anything. + case cands of + (pkg:pkgs) -> + parens (text "This unit ID looks like the source package ID;" $$ + text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$ + (if null pkgs then empty + else text "and" <+> int (length pkgs) <+> text "other candidates")) + -- Todo: also check if it looks like a package name! + [] -> empty + + in hsep [ text "no unit id matching" <+> quotes (ppr pkg) + , text "was found" $$ looks_like_srcpkgid ] + MissingPackageFiles pkg files -> + text "There are files missing in the " <> quotes (ppr pkg) <> + text " package," $$ + text "try running 'ghc-pkg check'." $$ + mayShowLocations verbose files + MissingPackageWayFiles build pkg files -> + text "Perhaps you haven't installed the " <> text build <> + text " libraries for package " <> quotes (ppr pkg) <> char '?' $$ + mayShowLocations verbose files + ModuleSuggestion ms fps -> + + let pp_suggestions :: [ModuleSuggestion] -> SDoc + pp_suggestions sugs + | null sugs = empty + | otherwise = hang (text "Perhaps you meant") + 2 (vcat (map pp_sugg sugs)) + + -- NB: Prefer the *original* location, and then reexports, and then + -- package flags when making suggestions. ToDo: if the original package + -- also has a reexport, prefer that one + pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o + where provenance ModHidden = empty + provenance (ModUnusable _) = empty + provenance (ModOrigin{ fromOrigUnit = e, + fromExposedReexport = res, + fromPackageFlag = f }) + | Just True <- e + = parens (text "from" <+> ppr (moduleUnit mod)) + | f && moduleName mod == m + = parens (text "from" <+> ppr (moduleUnit mod)) + | (pkg:_) <- res + = parens (text "from" <+> ppr (mkUnit pkg) + <> comma <+> text "reexporting" <+> ppr mod) + | f + = parens (text "defined via package flags to be" + <+> ppr mod) + | otherwise = empty + pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o + where provenance ModHidden = empty + provenance (ModUnusable _) = empty + provenance (ModOrigin{ fromOrigUnit = e, + fromHiddenReexport = rhs }) + | Just False <- e + = parens (text "needs flag -package-id" + <+> ppr (moduleUnit mod)) + | (pkg:_) <- rhs + = parens (text "needs flag -package-id" + <+> ppr (mkUnit pkg)) + | otherwise = empty + + in pp_suggestions ms $$ mayShowLocations verbose fps + NotAModule -> text "It is not a module in the current program, or in any known package." + CouldntFindInFiles fps -> vcat (map text fps) + MultiplePackages mods + | Just pkgs <- unambiguousPackages + -> sep [text "it was found in multiple packages:", + hsep (map ppr pkgs)] + | otherwise + -> vcat (map pprMod mods) + where + unambiguousPackages = foldl' unambiguousPackage (Just []) mods + unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) + = Just (moduleUnit m : xs) + unambiguousPackage _ _ = Nothing + GenericMissing using_cabal pkg_hiddens mod_hiddens unusables files -> + vcat (map (pkg_hidden using_cabal) pkg_hiddens) $$ + vcat (map mod_hidden mod_hiddens) $$ + vcat (map unusable unusables) $$ + mayShowLocations verbose files + where + pprMod (m, o) = text "it is bound as" <+> ppr m <+> + text "by" <+> pprOrigin m o + pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden" + pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable" + pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma ( + if e == Just True + then [text "package" <+> ppr (moduleUnit m)] + else [] ++ + map ((text "a reexport in package" <+>) + .ppr.mkUnit) res ++ + if f then [text "a package flag"] else [] + ) + pkg_hidden :: BuildingCabalPackage -> (Unit, Maybe UnitInfo) -> SDoc + pkg_hidden using_cabal (uid, uif) = + text "It is a member of the hidden package" + <+> quotes (ppr uid) + --FIXME: we don't really want to show the unit id here we should + -- show the source package id or installed package id if it's ambiguous + <> dot $$ pkg_hidden_hint using_cabal uif + + pkg_hidden_hint using_cabal (Just pkg) + | using_cabal == YesBuildingCabalPackage + = text "Perhaps you need to add" <+> + quotes (ppr (unitPackageName pkg)) <+> + text "to the build-depends in your .cabal file." + -- MP: This is ghci specific, remove + | otherwise + = text "You can run" <+> + quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> + text "to expose it." $$ + text "(Note: this unloads all the modules in the current scope.)" + pkg_hidden_hint _ Nothing = empty + + mod_hidden pkg = + text "it is a hidden module in the package" <+> quotes (ppr pkg) + + unusable (pkg, reason) + = text "It is a member of the package" + <+> quotes (ppr pkg) + $$ pprReason (text "which is") reason + +mayShowLocations :: Bool -> [FilePath] -> SDoc +mayShowLocations verbose files + | null files = empty + | not verbose = + text "Use -v (or `:set -v` in ghci) " <> + text "to see a list of the files searched for." + | otherwise = + hang (text "Locations searched:") 2 $ vcat (map text files) + +interfaceErrorDiagnostic :: Bool -> InterfaceError -> SDoc +interfaceErrorDiagnostic verbose_files = \ case + Can'tFindNameInInterface name relevant_tyThings -> + missingDeclInInterface name relevant_tyThings + Can'tFindInterface err looking_for -> + case looking_for of + LookingForName {} -> + missingInterfaceErrorDiagnostic verbose_files err + LookingForModule {} -> + missingInterfaceErrorDiagnostic verbose_files err + LookingForHiBoot mod -> + hang (text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon) + 2 (missingInterfaceErrorDiagnostic verbose_files err) + LookingForSig sig -> + hang (text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon) + 2 (missingInterfaceErrorDiagnostic verbose_files err) + +readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc +readInterfaceErrorDiagnostic = \ case + ExceptionOccurred fp ex -> + hang (text "Exception when reading interface file " <+> text fp) + 2 (text (showException ex)) + HiModuleNameMismatchWarn _ m1 m2 -> + hiModuleNameMismatchWarn m1 m2 + +missingInterfaceErrorDiagnostic :: Bool -> MissingInterfaceError -> SDoc +missingInterfaceErrorDiagnostic verbose_files reason = + case reason of + BadSourceImport m -> badSourceImport m + HomeModError im ml -> homeModError im ml + DynamicHashMismatchError m ml -> dynamicHashMismatchError m ml + CantFindErr us cfi -> pprWithUnitState us $ cantFindError verbose_files cfi + CantFindInstalledErr cfi -> cantFindError verbose_files cfi + BadIfaceFile rie -> readInterfaceErrorDiagnostic rie + FailedToLoadDynamicInterface wanted_mod err -> + hang (text "Failed to load dynamic interface file for" <+> ppr wanted_mod <> colon) + 2 (readInterfaceErrorDiagnostic err) + +hiModuleNameMismatchWarn :: Module -> Module -> SDoc +hiModuleNameMismatchWarn requested_mod read_mod + | moduleUnit requested_mod == moduleUnit read_mod = + sep [text "Interface file contains module" <+> quotes (ppr read_mod) <> comma, + text "but we were expecting module" <+> quotes (ppr requested_mod), + sep [text "Probable cause: the source code which generated interface file", + text "has an incompatible module name" + ] + ] + | otherwise = + -- ToDo: This will fail to have enough qualification when the package IDs + -- are the same + withPprStyle (mkUserStyle alwaysQualify AllTheWay) $ + -- we want the Modules below to be qualified with package names, + -- so reset the NamePprCtx setting. + hsep [ text "Something is amiss; requested module " + , ppr requested_mod + , text "differs from name found in the interface file" + , ppr read_mod + , parens (text "if these names look the same, try again with -dppr-debug") + ] + +dynamicHashMismatchError :: Module -> ModLocation -> SDoc +dynamicHashMismatchError wanted_mod loc = + vcat [ text "Dynamic hash doesn't match for" <+> quotes (ppr wanted_mod) + , text "Normal interface file from" <+> text (ml_hi_file loc) + , text "Dynamic interface file from" <+> text (ml_dyn_hi_file loc) + , text "You probably need to recompile" <+> quotes (ppr wanted_mod) ] + +homeModError :: InstalledModule -> ModLocation -> SDoc +-- See Note [Home module load error] +homeModError mod location + = text "attempting to use module " <> quotes (ppr mod) + <> (case ml_hs_file location of + Just file -> space <> parens (text file) + Nothing -> empty) + <+> text "which is not loaded" + + +missingDeclInInterface :: Name -> [TyThing] -> SDoc +missingDeclInInterface name things = + whenPprDebug (found_things $$ empty) $$ + hang (text "Can't find interface-file declaration for" <+> + pprNameSpace (nameNameSpace name) <+> ppr name) + 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", + text "Use -ddump-if-trace to get an idea of which file caused the error"]) + where + found_things = + hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon) + 2 (vcat (map ppr things)) + +badSourceImport :: Module -> SDoc +badSourceImport mod + = hang (text "You cannot {-# SOURCE #-} import a module from another package") + 2 (text "but" <+> quotes (ppr mod) <+> text "is from package" + <+> quotes (ppr (moduleUnit mod))) + deriveInstanceErrReasonHints :: Class -> UsingGeneralizedNewtypeDeriving -> DeriveInstanceErrReason ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -48,6 +48,16 @@ module GHC.Tc.Errors.Types ( , HsDocContext(..) , FixedRuntimeRepErrorInfo(..) + , MissingInterfaceError(..) + , InterfaceLookingFor(..) + , InterfaceError(..) + , ReadInterfaceError(..) + , CantFindInstalled(..) + , CantFindInstalledReason(..) + , CantFindWhat(..) + + , BuildingCabalPackage(..) + , ErrorItem(..), errorItemOrigin, errorItemEqRel, errorItemPred, errorItemCtLoc , SolverReport(..), SolverReportSupplementary(..) @@ -105,6 +115,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , FixedRuntimeRepOrigin(..) ) import GHC.Tc.Types.Rank (Rank) import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType) +import GHC.Types.Basic import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) import GHC.Types.ForeignCall (CLabelString) @@ -116,7 +127,7 @@ import GHC.Types.TyThing (TyThing) import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar) import GHC.Types.Var.Env (TidyEnv) import GHC.Types.Var.Set (TyVarSet, VarSet) -import GHC.Unit.Types (Module) +import GHC.Unit.Types (Module, InstalledModule, UnitId, Unit) import GHC.Utils.Outputable import GHC.Core.Class (Class, ClassMinimalDef) import GHC.Core.Coercion.Axiom (CoAxBranch) @@ -129,8 +140,7 @@ import GHC.Core.Predicate (EqRel, predTypeEqRel) import GHC.Core.TyCon (TyCon, TyConFlavour) import GHC.Core.Type (Kind, Type, ThetaType, PredType) import GHC.Driver.Backend (Backend) -import GHC.Unit.State (UnitState) -import GHC.Types.Basic +import GHC.Unit.State (UnitState, ModuleSuggestion, ModuleOrigin, UnusableUnitReason, UnitInfo) import GHC.Utils.Misc (capitalise, filterOut) import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString (FastString) @@ -144,6 +154,7 @@ import GHC.Unit.Module.Warnings (WarningTxt) import qualified Language.Haskell.TH.Syntax as TH import GHC.Generics ( Generic ) +import GHC.Unit.Module.Location {- Note [Migrating TcM Messages] @@ -2546,14 +2557,6 @@ data TcRnMessage where -> !String -- Error body -> TcRnMessage - {-| TcRnInterfaceLookupError is an error resulting from looking up a name in an interface file. - - Example(s): - - Test cases: - -} - TcRnInterfaceLookupError :: !Name -> !SDoc -> TcRnMessage - {- | TcRnUnsatisfiedMinimalDef is a warning that occurs when a class instance is missing methods that are required by the minimal definition. @@ -3178,6 +3181,10 @@ data TcRnMessage where -} TcRnUnknownTyVarsOnRhsOfInjCond :: [Name] -> TcRnMessage + TcRnCan'tFindLocalName :: !Name -> TcRnMessage + + TcRnInterfaceError :: !InterfaceError -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -3596,6 +3603,61 @@ instance Outputable Exported where ppr IsNotExported = text "IsNotExported" ppr IsExported = text "IsExported" +data InterfaceLookingFor + = LookingForName !Name + | LookingForHiBoot !Module + | LookingForModule !ModuleName !IsBootInterface + | LookingForSig !InstalledModule + +data InterfaceError + = Can'tFindInterface + MissingInterfaceError + InterfaceLookingFor + | Can'tFindNameInInterface + Name + [TyThing] -- possibly relevant TyThings + deriving Generic + +data MissingInterfaceError + = BadSourceImport !Module + | HomeModError !InstalledModule !ModLocation + | DynamicHashMismatchError !Module !ModLocation + + -- TODO: common up these two + | CantFindErr !UnitState CantFindInstalled + | CantFindInstalledErr CantFindInstalled + + | BadIfaceFile ReadInterfaceError + | FailedToLoadDynamicInterface Module ReadInterfaceError + deriving Generic + +data ReadInterfaceError + = ExceptionOccurred FilePath SomeException + | HiModuleNameMismatchWarn FilePath Module Module + deriving Generic + +data CantFindInstalledReason + = NoUnitIdMatching UnitId [UnitInfo] + | MissingPackageFiles UnitId [FilePath] + | MissingPackageWayFiles String UnitId [FilePath] + | ModuleSuggestion [ModuleSuggestion] [FilePath] + | NotAModule + | CouldntFindInFiles [FilePath] + | GenericMissing BuildingCabalPackage + [(Unit, Maybe UnitInfo)] [Unit] + [(Unit, UnusableUnitReason)] [FilePath] + | MultiplePackages [(Module, ModuleOrigin)] + deriving Generic + +data CantFindInstalled = + CantFindInstalled ModuleName CantFindWhat CantFindInstalledReason + deriving Generic + +data CantFindWhat + = CantFindModule | CantLoadModule | CantLoadInterface + | AmbiguousInterface | AmbiguousModule + -- TODO? + -------------------------------------------------------------------------------- -- -- Errors used in GHC.Tc.Errors @@ -4419,3 +4481,11 @@ data NonStandardGuards where data RuleLhsErrReason = UnboundVariable RdrName NotInScopeError | IllegalExpression + +-- | Pass to a 'DriverMessage' the information whether or not the +-- '-fbuilding-cabal-package' flag is set. +data BuildingCabalPackage + = YesBuildingCabalPackage + | NoBuildingCabalPackage + deriving Eq + ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2024,7 +2024,7 @@ tcLookupTh name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return (AGlobal thing) - Failed msg -> failWithTc (TcRnInterfaceLookupError name msg) + Failed msg -> failWithTc (TcRnInterfaceError msg) }}}} notInScope :: TH.Name -> TcRnMessage ===================================== compiler/GHC/Tc/Utils/Backpack.hs ===================================== @@ -168,7 +168,7 @@ checkHsigIface tcg_env gr sig_iface -- tcg_env (TODO: but maybe this isn't relevant anymore). r <- tcLookupImported_maybe name case r of - Failed err -> addErr (TcRnInterfaceLookupError name err) + Failed err -> addErr (TcRnInterfaceError err) Succeeded real_thing -> checkHsigDeclM sig_iface sig_thing real_thing -- The hsig did NOT define this function; that means it must @@ -278,7 +278,7 @@ findExtraSigImports hsc_env HsigFile modname = do reqs = requirementMerges unit_state modname holes <- forM reqs $ \(Module iuid mod_name) -> do initIfaceLoad hsc_env - . withException ctx + . withIfaceErr ctx $ moduleFreeHolesPrecise (text "findExtraSigImports") (mkModule (VirtUnit iuid) mod_name) return (uniqDSetToList (unionManyUniqDSets holes)) @@ -563,9 +563,8 @@ mergeSignatures im = fst (getModuleInstantiation m) ctx = initSDocContext dflags defaultUserStyle fmap fst - . withException ctx - $ findAndReadIface hsc_env - (text "mergeSignatures") im m NotBoot + . withIfaceErr ctx + $ findAndReadIface hsc_env (text "mergeSignatures") im m NotBoot -- STEP 3: Get the unrenamed exports of all these interfaces, -- thin it according to the export list, and do shaping on them. @@ -996,9 +995,9 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do isig_mod sig_mod NotBoot isig_iface <- case mb_isig_iface of Succeeded (iface, _) -> return iface - Failed err -> failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Could not find hi interface for signature" <+> - quotes (ppr isig_mod) <> colon) 4 err + Failed err -> + failWithTc $ TcRnInterfaceError $ + Can'tFindInterface err (LookingForSig isig_mod) -- STEP 3: Check that the implementing interface exports everything -- we need. (Notice we IGNORE the Modules in the AvailInfos.) ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -24,7 +24,7 @@ module GHC.Tc.Utils.Env( tcLookupDataCon, tcLookupPatSyn, tcLookupConLike, tcLookupLocatedGlobalId, tcLookupLocatedTyCon, tcLookupLocatedClass, tcLookupAxiom, - lookupGlobal, lookupGlobal_maybe, ioLookupDataCon, + lookupGlobal, lookupGlobal_maybe, addTypecheckedBinds, -- Local environment @@ -136,6 +136,8 @@ import Data.IORef import Data.List (intercalate) import Control.Monad import GHC.Driver.Env.KnotVars +import GHC.Utils.Error (formatBulleted) +import GHC.Driver.Config.Diagnostic (initTcMessageOpts) {- ********************************************************************* * * @@ -151,10 +153,13 @@ lookupGlobal hsc_env name mb_thing <- lookupGlobal_maybe hsc_env name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> pprPanic "lookupGlobal" msg + Failed err -> + let err_txt = formatBulleted + $ diagnosticMessage (initTcMessageOpts (hsc_dflags hsc_env)) + err + in pprPanic "lookupGlobal" err_txt } - -lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing) +lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr TcRnMessage TyThing) -- This may look up an Id that one has previously looked up. -- If so, we are going to read its interface file, and add its bindings -- to the ExternalPackageTable. @@ -165,24 +170,26 @@ lookupGlobal_maybe hsc_env name tcg_semantic_mod = homeModuleInstantiation mhome_unit mod ; if nameIsLocalOrFrom tcg_semantic_mod name - then (return - (Failed (text "Can't find local name: " <+> ppr name))) - -- Internal names can happen in GHCi - else - -- Try home package table and external package table - lookupImported_maybe hsc_env name + then return $ Failed $ TcRnCan'tFindLocalName name + -- Internal names can happen in GHCi + else do + res <- lookupImported_maybe hsc_env name + -- Try home package table and external package table + return $ case res of + Succeeded ok -> Succeeded ok + Failed err -> Failed (TcRnInterfaceError err) } -lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing) +lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr InterfaceError TyThing) -- Returns (Failed err) if we can't find the interface file for the thing lookupImported_maybe hsc_env name = do { mb_thing <- lookupType hsc_env name ; case mb_thing of Just thing -> return (Succeeded thing) Nothing -> importDecl_maybe hsc_env name - } + } -importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing) +importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr InterfaceError TyThing) importDecl_maybe hsc_env name | Just thing <- wiredInNameTyThing_maybe name = do { when (needWiredInHomeIface thing) @@ -192,22 +199,6 @@ importDecl_maybe hsc_env name | otherwise = initIfaceLoad hsc_env (importDecl name) -ioLookupDataCon :: HscEnv -> Name -> IO DataCon -ioLookupDataCon hsc_env name = do - mb_thing <- ioLookupDataCon_maybe hsc_env name - case mb_thing of - Succeeded thing -> return thing - Failed msg -> pprPanic "lookupDataConIO" msg - -ioLookupDataCon_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc DataCon) -ioLookupDataCon_maybe hsc_env name = do - thing <- lookupGlobal hsc_env name - return $ case thing of - AConLike (RealDataCon con) -> Succeeded con - _ -> Failed $ - pprTcTyThingCategory (AGlobal thing) <+> quotes (ppr name) <+> - text "used as a data constructor" - addTypecheckedBinds :: TcGblEnv -> [LHsBinds GhcTc] -> TcGblEnv addTypecheckedBinds tcg_env binds | isHsBootOrSig (tcg_src tcg_env) = tcg_env @@ -257,7 +248,7 @@ tcLookupGlobal name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> failWithTc (TcRnInterfaceLookupError name msg) + Failed msg -> failWithTc (TcRnInterfaceError msg) }}} -- Look up only in this module's global env't. Don't look in imports, etc. ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -138,7 +139,7 @@ module GHC.Tc.Utils.Monad( forkM, setImplicitEnvM, - withException, + withException, withIfaceErr, -- * Stuff for cost centres. getCCIndexM, getCCIndexTcM, @@ -217,6 +218,7 @@ import Data.IORef import Control.Monad import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Ppr import {-# SOURCE #-} GHC.Tc.Utils.Env ( tcInitTidyEnv ) import qualified Data.Map as Map @@ -663,6 +665,16 @@ withException ctx do_this = do Failed err -> liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx err)) Succeeded result -> return result +withIfaceErr :: MonadIO m => SDocContext -> m (MaybeErr MissingInterfaceError a) -> m a +withIfaceErr ctx do_this = do + r <- do_this + case r of + Failed err -> do + let tries = tcOptsShowTriedFiles $ defaultDiagnosticOpts @TcRnMessage + msg = missingInterfaceErrorDiagnostic tries err + liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx msg)) + Succeeded result -> return result + {- ************************************************************************ * * ===================================== compiler/GHC/Types/Error.hs ===================================== @@ -35,6 +35,8 @@ module GHC.Types.Error , mkDecoratedDiagnostic , mkDecoratedError + , pprDiagnostic + , NoDiagnosticOpts(..) -- * Hints and refactoring actions ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -530,6 +530,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnShadowedTyVarNameInFamResult" = 99412 GhcDiagnosticCode "TcRnIncorrectTyVarOnLhsOfInjCond" = 88333 GhcDiagnosticCode "TcRnUnknownTyVarsOnRhsOfInjCond" = 48254 + GhcDiagnosticCode "TcRnCan'tFindLocalName" = 11111 -- SLD TODO -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 @@ -583,6 +584,28 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "OneArgExpected" = 91490 GhcDiagnosticCode "AtLeastOneArgExpected" = 07641 + -- Interface errors + GhcDiagnosticCode "BadSourceImport" = 00001 + GhcDiagnosticCode "MissingDeclInInterface" = 00002 + GhcDiagnosticCode "MissingInterfaceError" = 00003 + GhcDiagnosticCode "HomeModError" = 00004 + GhcDiagnosticCode "DynamicHashMismatchError" = 00005 + GhcDiagnosticCode "BadIfaceFile" = 00006 + GhcDiagnosticCode "FailedToLoadDynamicInterface" = 00010 + GhcDiagnosticCode "UsedAsDataConstructor" = 00014 + GhcDiagnosticCode "CouldntFindInFiles" = 00016 + GhcDiagnosticCode "GenericMissing" = 00017 + GhcDiagnosticCode "MissingPackageFiles" = 00018 + GhcDiagnosticCode "MissingPackageWayFiles" = 00019 + GhcDiagnosticCode "ModuleSuggestion" = 00020 + GhcDiagnosticCode "MultiplePackages" = 00022 + GhcDiagnosticCode "NoUnitIdMatching" = 00023 + GhcDiagnosticCode "NotAModule" = 00024 + GhcDiagnosticCode "Can'tFindNameInInterface" = 00026 + + GhcDiagnosticCode "HiModuleNameMismatchWarn" = 00012 + GhcDiagnosticCode "ExceptionOccurred" = 00011 + -- Out of scope errors GhcDiagnosticCode "NotInScope" = 76037 GhcDiagnosticCode "NoExactName" = 97784 @@ -670,6 +693,15 @@ type family ConRecursInto con where ConRecursInto "DriverUnknownMessage" = 'Just UnknownDiagnostic ConRecursInto "DriverPsHeaderMessage" = 'Just PsMessage + ConRecursInto "DriverInterfaceError" = 'Just MissingInterfaceError + + ConRecursInto "CantFindErr" = 'Just CantFindInstalled + ConRecursInto "CantFindInstalledErr" = 'Just CantFindInstalled + + ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason + + ConRecursInto "BadIfaceFile" = 'Just ReadInterfaceError + ConRecursInto "FailedToLoadDynamicInterface" = 'Just ReadInterfaceError ---------------------------------- -- Constructors of PsMessage @@ -698,6 +730,11 @@ type family ConRecursInto con where ConRecursInto "TcRnRunSpliceFailure" = 'Just RunSpliceFailReason ConRecursInto "ConversionFail" = 'Just ConversionFailReason + -- Interface file errors + + ConRecursInto "TcRnInterfaceError" = 'Just InterfaceError + ConRecursInto "Can'tFindInterface" = 'Just MissingInterfaceError + ------------------ -- FFI errors ===================================== compiler/GHC/Utils/Error.hs ===================================== @@ -219,14 +219,14 @@ getInvalids vs = [d | NotValid d <- vs] ---------------- -- | Formats the input list of structured document, where each element of the list gets a bullet. -formatBulleted :: SDocContext -> DecoratedSDoc -> SDoc -formatBulleted ctx (unDecorated -> docs) - = case msgs of +formatBulleted :: DecoratedSDoc -> SDoc +formatBulleted (unDecorated -> docs) + = sdocWithContext $ \ctx -> case msgs ctx of [] -> Outputable.empty [msg] -> msg - _ -> vcat $ map starred msgs + xs -> vcat $ map starred xs where - msgs = filter (not . Outputable.isEmpty ctx) docs + msgs ctx = filter (not . Outputable.isEmpty ctx) docs starred = (bullet<+>) pprMessages :: Diagnostic e => DiagnosticOpts e -> Messages e -> SDoc @@ -248,12 +248,11 @@ pprLocMsgEnvelope opts (MsgEnvelope { errMsgSpan = s , errMsgDiagnostic = e , errMsgSeverity = sev , errMsgContext = name_ppr_ctx }) - = sdocWithContext $ \ctx -> - withErrStyle name_ppr_ctx $ + = withErrStyle name_ppr_ctx $ mkLocMessage (MCDiagnostic sev (diagnosticReason e) (diagnosticCode e)) s - (formatBulleted ctx $ diagnosticMessage opts e) + (formatBulleted $ diagnosticMessage opts e) sortMsgBag :: Maybe DiagOpts -> Bag (MsgEnvelope e) -> [MsgEnvelope e] sortMsgBag mopts = maybeLimit . sortBy (cmp `on` errMsgSpan) . bagToList ===================================== ghc/GHCi/UI.hs ===================================== @@ -35,6 +35,7 @@ import qualified GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls' ) import GHCi.UI.Monad hiding ( args, runStmt ) import GHCi.UI.Tags import GHCi.UI.Info +import GHCi.UI.Exception import GHC.Runtime.Debugger -- The GHC interface @@ -1115,7 +1116,7 @@ runOneCommand eh gCmd = do -- is the handler necessary here? where printErrorAndFail err = do - GHC.printException err + printGhciException err return $ Just False -- Exit ghc -e, but not GHCi noSpace q = q >>= maybe (return Nothing) @@ -1588,7 +1589,7 @@ help _ = do info :: GHC.GhcMonad m => Bool -> String -> m () info _ "" = throwGhcException (CmdLineError "syntax: ':i '") -info allInfo s = handleSourceError GHC.printException $ do +info allInfo s = handleSourceError printGhciException $ do forM_ (words s) $ \thing -> do sdoc <- infoThing allInfo thing rendered <- showSDocForUser' sdoc @@ -2002,7 +2003,7 @@ instancesCmd :: String -> InputT GHCi () instancesCmd "" = throwGhcException (CmdLineError "syntax: ':instances '") instancesCmd s = do - handleSourceError GHC.printException $ do + handleSourceError printGhciException $ do ty <- GHC.parseInstanceHead s res <- GHC.getInstancesForType ty @@ -2309,7 +2310,7 @@ modulesLoadedMsg ok mods = do -- and printing 'throwE' strings to 'stderr'. If in expression -- evaluation mode - throw GhcException and exit. runExceptGhciMonad :: GhciMonad m => ExceptT SDoc m () -> m () -runExceptGhciMonad act = handleSourceError GHC.printException $ +runExceptGhciMonad act = handleSourceError printGhciException $ either handleErr pure =<< runExceptT act where @@ -4543,7 +4544,7 @@ failIfExprEvalMode = do -- | When in expression evaluation mode (ghc -e), we want to exit immediately. -- Otherwis, just print out the message. printErrAndMaybeExit :: (GhciMonad m, MonadIO m, HasLogger m) => SourceError -> m () -printErrAndMaybeExit = (>> failIfExprEvalMode) . GHC.printException +printErrAndMaybeExit = (>> failIfExprEvalMode) . printGhciException ----------------------------------------------------------------------------- -- recursive exception handlers @@ -4641,7 +4642,7 @@ wantNameFromInterpretedModule :: GHC.GhcMonad m -> (Name -> m ()) -> m () wantNameFromInterpretedModule noCanDo str and_then = - handleSourceError GHC.printException $ do + handleSourceError printGhciException $ do n NE.:| _ <- GHC.parseName str let modl = assert (isExternalName n) $ GHC.nameModule n if not (GHC.isExternalName n) ===================================== ghc/GHCi/UI/Exception.hs ===================================== @@ -0,0 +1,42 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module GHCi.UI.Exception(printGhciException) where + +import GHC.Prelude +import GHC.Utils.Logger +import Control.Monad.IO.Class +import GHC.Driver.Session +import GHC.Types.SourceError +import GHC.Driver.Errors.Types +import GHC.Types.Error +import GHC.Driver.Config.Diagnostic +import GHC.Driver.Errors + +-- | Print the all diagnostics in a 'SourceError'. Specialised for GHCi error reporting +-- for some error messages. +printGhciException :: (HasLogger m, MonadIO m, HasDynFlags m) => SourceError -> m () +printGhciException err = do + dflags <- getDynFlags + logger <- getLogger + let !diag_opts = initDiagOpts dflags + !print_config = initPrintConfig dflags + liftIO $ printMessages logger print_config diag_opts (GHCiMessage <$> (srcErrorMessages err)) + + +newtype GHCiMessage = GHCiMessage { getGhciMessage :: GhcMessage } + +instance Diagnostic GHCiMessage where + type DiagnosticOpts GHCiMessage = DiagnosticOpts GhcMessage + + defaultDiagnosticOpts = defaultDiagnosticOpts @GhcMessage + + diagnosticMessage opts (GHCiMessage msg) = diagnosticMessage opts msg + + diagnosticReason (GHCiMessage msg) = diagnosticReason msg + + diagnosticHints (GHCiMessage msg) = diagnosticHints msg + + diagnosticCode (GHCiMessage msg) = diagnosticCode msg + + ===================================== ghc/Main.hs ===================================== @@ -79,12 +79,13 @@ import GHC.Iface.Load import GHC.Iface.Recomp.Binary ( fingerprintBinMem ) import GHC.Tc.Utils.Monad ( initIfaceCheck ) -import System.FilePath +import GHC.Tc.Errors.Ppr -- Standard Haskell libraries import System.IO import System.Environment import System.Exit +import System.FilePath import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.Except (throwE, runExceptT) @@ -1100,8 +1101,11 @@ abiHash strs = do r <- findImportedModule hsc_env modname NoPkgQual case r of Found _ m -> return m - _error -> throwGhcException $ CmdLineError $ showSDoc dflags $ - cannotFindModule hsc_env modname r + _error -> + let tries = tcOptsShowTriedFiles $ initTcMessageOpts dflags + err_txt = missingInterfaceErrorDiagnostic tries + $ cannotFindModule hsc_env modname r + in throwGhcException . CmdLineError $ showSDoc dflags err_txt mods <- mapM find_it strs ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -69,6 +69,7 @@ Executable ghc GHCi.UI.Info GHCi.UI.Monad GHCi.UI.Tags + GHCi.UI.Exception GHCi.Util Other-Extensions: FlexibleInstances View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/abac1c81d6428294878df0a35a42ebfea5c03a8e...53cb7758762332ae300df5191f633e2ab1fb05f4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/abac1c81d6428294878df0a35a42ebfea5c03a8e...53cb7758762332ae300df5191f633e2ab1fb05f4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 12:18:42 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 16 Mar 2023 08:18:42 -0400 Subject: [Git][ghc/ghc][wip/jsem] 5 commits: Bump Win32 to 2.13.4.0 Message-ID: <64130922c7671_37e76b36658d18453311@gitlab.mail> Matthew Pickering pushed to branch wip/jsem at Glasgow Haskell Compiler / GHC Commits: 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - 588d5cc7 by sheaf at 2023-03-16T12:17:41+00:00 parent ad612f555821a44260e5d9654f940b71f5180817 author sheaf <sam.derbyshire at gmail.com> 1662553354 +0200 committer Matthew Pickering <matthewtpickering at gmail.com> 1671366685 +0000 WIP: jsem, using POSIX/Win32 semaphores Updates submodule - - - - - 1d099134 by sheaf at 2023-03-16T12:17:41+00:00 some rewording of jsem notes - - - - - 1afc6024 by Matthew Pickering at 2023-03-16T12:17:41+00:00 fixes - - - - - 16 changed files: - .gitmodules - cabal.project-reinstall - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/ghc.cabal.in - docs/users_guide/using.rst - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - libraries/Win32 - libraries/ghc-bignum/ghc-bignum.cabal - + libraries/semaphore-compat - packages Changes: ===================================== .gitmodules ===================================== @@ -83,6 +83,10 @@ url = https://gitlab.haskell.org/ghc/packages/unix.git ignore = untracked branch = 2.7 +[submodule "libraries/semaphore-compat"] + path = libraries/semaphore-compat + url = https://gitlab.haskell.org/ghc/semaphore-compat.git + ignore = untracked [submodule "libraries/stm"] path = libraries/stm url = https://gitlab.haskell.org/ghc/packages/stm.git ===================================== cabal.project-reinstall ===================================== @@ -28,6 +28,7 @@ packages: ./compiler ./libraries/parsec/ -- ./libraries/pretty/ ./libraries/process/ + ./libraries/semaphore-compat ./libraries/stm -- ./libraries/template-haskell/ ./libraries/terminfo/ ===================================== compiler/GHC/Driver/Config.hs ===================================== @@ -38,8 +38,10 @@ initBCOOpts dflags = do -- Serializing ResolvedBCO is expensive, so if we're in parallel mode -- (-j) parallelise the serialization. n_jobs <- case parMakeCount dflags of - Nothing -> liftIO getNumProcessors - Just n -> return n + Nothing -> pure 1 + Just (ParMakeThisMany n) -> pure n + Just ParMakeNumProcessors -> liftIO getNumProcessors + -- jsem TODO return $ BCOOpts n_jobs -- | Extract GHCi options from DynFlags and step ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -75,6 +75,7 @@ import GHC.Driver.Env import GHC.Driver.Errors import GHC.Driver.Errors.Types import GHC.Driver.Main +import GHC.Driver.MakeSem import GHC.Parser.Header @@ -149,9 +150,9 @@ import GHC.Runtime.Loader import GHC.Rename.Names import GHC.Utils.Constants import GHC.Types.Unique.DFM (udfmRestrictKeysSet) -import qualified Data.IntSet as I import GHC.Types.Unique +import qualified Data.IntSet as I -- ----------------------------------------------------------------------------- -- Loading the program @@ -657,6 +658,34 @@ createBuildPlan mod_graph maybe_top_mod = (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (length (mgModSummaries' mod_graph )))]) build_plan +-- data ParMakeMode = ParallelMake | SequentialMake +-- deriving (Eq, Show) + +mkWorkerLimit :: DynFlags -> IO WorkerLimit +mkWorkerLimit dflags = + case jsemHandle dflags of + Just h -> pure (JSemLimit $ SemaphoreName h) + Nothing -> case parMakeCount dflags of + Nothing -> pure $ num_procs 1 + Just ParMakeNumProcessors -> num_procs <$> getNumProcessors + Just (ParMakeThisMany n) -> pure $ num_procs n + where + num_procs x = NumProcessorsLimit (max 1 x) + +isWorkerLimitSequential :: WorkerLimit -> Bool +isWorkerLimitSequential (NumProcessorsLimit x) = x <= 1 +isWorkerLimitSequential (JSemLimit {}) = False + +-- | This describes what we use to limit the number of jobs, either we limit it +-- ourselves to a specific number or we have an external parallelism semaphore +-- limit it for us. +data WorkerLimit + = NumProcessorsLimit Int + | JSemLimit + SemaphoreName + -- ^ Semaphore name to use + deriving Eq + -- | Generalized version of 'load' which also supports a custom -- 'Messager' (for reporting progress) and 'ModuleGraph' (generally -- produced by calling 'depanal'. @@ -737,14 +766,12 @@ load' mhmi_cache how_much mHscMessage mod_graph = do liftIO $ debugTraceMsg logger 2 (hang (text "Ready for upsweep") 2 (ppr build_plan)) - n_jobs <- case parMakeCount (hsc_dflags hsc_env) of - Nothing -> liftIO getNumProcessors - Just n -> return n + worker_limit <- liftIO $ mkWorkerLimit dflags setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do hsc_env <- getSession - liftIO $ upsweep n_jobs hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan + liftIO $ upsweep worker_limit hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan setSession hsc_env1 case upsweep_ok of Failed -> loadFinish upsweep_ok @@ -1029,13 +1056,7 @@ getDependencies direct_deps build_map = type BuildM a = StateT BuildLoopState IO a --- | Abstraction over the operations of a semaphore which allows usage with the --- -j1 case -data AbstractSem = AbstractSem { acquireSem :: IO () - , releaseSem :: IO () } -withAbstractSem :: AbstractSem -> IO b -> IO b -withAbstractSem sem = MC.bracket_ (acquireSem sem) (releaseSem sem) -- | Environment used when compiling a module data MakeEnv = MakeEnv { hsc_env :: !HscEnv -- The basic HscEnv which will be augmented for each module @@ -1220,7 +1241,7 @@ withCurrentUnit uid = do local (\env -> env { hsc_env = hscSetActiveUnitId uid (hsc_env env)}) upsweep - :: Int -- ^ The number of workers we wish to run in parallel + :: WorkerLimit -- ^ The number of workers we wish to run in parallel -> HscEnv -- ^ The base HscEnv, which is augmented for each module -> Maybe ModIfaceCache -- ^ A cache to incrementally write final interface files to -> Maybe Messager @@ -2825,7 +2846,7 @@ label_self thread_name = do CC.labelThread self_tid thread_name -runPipelines :: Int -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () +runPipelines :: WorkerLimit -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () -- Don't even initialise plugins if there are no pipelines runPipelines _ _ _ [] = return () runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do @@ -2833,7 +2854,7 @@ runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do plugins_hsc_env <- initializePlugins orig_hsc_env case n_job of - 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines + NumProcessorsLimit n | n <= 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines _n -> runParPipelines n_job plugins_hsc_env mHscMessager all_pipelines runSeqPipelines :: HscEnv -> Maybe Messager -> [MakeAction] -> IO () @@ -2843,16 +2864,40 @@ runSeqPipelines plugin_hsc_env mHscMessager all_pipelines = , compile_sem = AbstractSem (return ()) (return ()) , env_messager = mHscMessager } - in runAllPipelines 1 env all_pipelines + in runAllPipelines (NumProcessorsLimit 1) env all_pipelines + + -- TODO remove this capabilities management, it will be handled by the semaphore +runNjobsAbstractSem :: Int -> (AbstractSem -> IO a) -> IO a +runNjobsAbstractSem n_jobs action = do + compile_sem <- newQSem n_jobs + n_capabilities <- getNumCapabilities + n_cpus <- getNumProcessors + let + asem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + set_num_caps n = unless (n_capabilities /= 1) $ setNumCapabilities n + updNumCapabilities = do + -- Setting number of capabilities more than + -- CPU count usually leads to high userspace + -- lock contention. #9221 + set_num_caps $ min n_jobs n_cpus + resetNumCapabilities = set_num_caps n_capabilities + MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem + +runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a +runWorkerLimit worker_limit action = case worker_limit of + NumProcessorsLimit n_jobs -> + runNjobsAbstractSem n_jobs action + JSemLimit sem -> + runJSemAbstractSem sem action -- | Build and run a pipeline -runParPipelines :: Int -- ^ How many capabilities to use - -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module +runParPipelines :: WorkerLimit -- ^ How to limit work parallelism + -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module -> Maybe Messager -- ^ Optional custom messager to use to report progress -> [MakeAction] -- ^ The build plan for all the module nodes -> IO () -runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do +runParPipelines worker_limit plugin_hsc_env mHscMessager all_pipelines = do -- A variable which we write to when an error has happened and we have to tell the @@ -2862,39 +2907,23 @@ runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do -- will add it's LogQueue into this queue. log_queue_queue_var <- newTVarIO newLogQueueQueue -- Thread which coordinates the printing of logs - wait_log_thread <- logThread n_jobs (length all_pipelines) (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var + wait_log_thread <- logThread (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var -- Make the logger thread-safe, in case there is some output which isn't sent via the LogQueue. thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env) let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger } - let updNumCapabilities = liftIO $ do - n_capabilities <- getNumCapabilities - n_cpus <- getNumProcessors - -- Setting number of capabilities more than - -- CPU count usually leads to high userspace - -- lock contention. #9221 - let n_caps = min n_jobs n_cpus - unless (n_capabilities /= 1) $ setNumCapabilities n_caps - return n_capabilities - - let resetNumCapabilities orig_n = do - liftIO $ setNumCapabilities orig_n - atomically $ writeTVar stopped_var True - wait_log_thread - - compile_sem <- newQSem n_jobs - let abstract_sem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + runWorkerLimit worker_limit $ \abstract_sem -> do + let env = MakeEnv { hsc_env = thread_safe_hsc_env + , withLogger = withParLog log_queue_queue_var + , compile_sem = abstract_sem + , env_messager = mHscMessager + } -- Reset the number of capabilities once the upsweep ends. - let env = MakeEnv { hsc_env = thread_safe_hsc_env - , withLogger = withParLog log_queue_queue_var - , compile_sem = abstract_sem - , env_messager = mHscMessager - } - - MC.bracket updNumCapabilities resetNumCapabilities $ \_ -> - runAllPipelines n_jobs env all_pipelines + runAllPipelines worker_limit env all_pipelines + atomically $ writeTVar stopped_var True + wait_log_thread withLocalTmpFS :: RunMakeM a -> RunMakeM a withLocalTmpFS act = do @@ -2911,10 +2940,11 @@ withLocalTmpFS act = do MC.bracket initialiser finaliser $ \lcl_hsc_env -> local (\env -> env { hsc_env = lcl_hsc_env}) act -- | Run the given actions and then wait for them all to finish. -runAllPipelines :: Int -> MakeEnv -> [MakeAction] -> IO () -runAllPipelines n_jobs env acts = do - let spawn_actions :: IO [ThreadId] - spawn_actions = if n_jobs == 1 +runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO () +runAllPipelines worker_limit env acts = do + let single_worker = isWorkerLimitSequential worker_limit + spawn_actions :: IO [ThreadId] + spawn_actions = if single_worker then (:[]) <$> (forkIOWithUnmask $ \unmask -> void $ runLoop (\io -> io unmask) env acts) else runLoop forkIOWithUnmask env acts ===================================== compiler/GHC/Driver/MakeSem.hs ===================================== @@ -0,0 +1,549 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE NumericUnderscores #-} + +-- | Implementation of a jobserver using system semaphores. +-- +-- +module GHC.Driver.MakeSem + ( -- * JSem: parallelism semaphore backed + -- by a system semaphore (Posix/Windows) + runJSemAbstractSem + + -- * System semaphores + , Semaphore, SemaphoreName(..) + + -- * Abstract semaphores + , AbstractSem(..) + , withAbstractSem + ) + where + +import GHC.Prelude +import GHC.Conc +import GHC.Data.OrdList +import GHC.IO.Exception +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Json + +import System.Semaphore + +import Control.Monad +import qualified Control.Monad.Catch as MC +import Control.Concurrent.MVar +import Control.Concurrent.STM +import Data.Foldable +import Data.Functor +import GHC.Stack +import Debug.Trace + +--------------------------------------- +-- Semaphore jobserver + +-- | A jobserver based off a system 'Semaphore'. +-- +-- Keeps track of the pending jobs and resources +-- available from the semaphore. +data Jobserver + = Jobserver + { jSemaphore :: !Semaphore + -- ^ The semaphore which controls available resources + , jobs :: !(TVar JobResources) + -- ^ The currently pending jobs, and the resources + -- obtained from the semaphore + } + +data JobserverOptions + = JobserverOptions + { releaseDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between acquiring a token + -- and releasing a token. + , setNumCapsDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between two consecutive + -- calls of 'setNumCapabilities'. + } + +defaultJobserverOptions :: JobserverOptions +defaultJobserverOptions = + JobserverOptions + { releaseDebounce = 1000 -- 1 second + , setNumCapsDebounce = 1000 -- 1 second + } + +-- | Resources available for running jobs, i.e. +-- tokens obtained from the parallelism semaphore. +data JobResources + = Jobs + { tokensOwned :: !Int + -- ^ How many tokens have been claimed from the semaphore + , tokensFree :: !Int + -- ^ How many tokens are not currently being used + , jobsWaiting :: !(OrdList (TMVar ())) + -- ^ Pending jobs waiting on a token + } + +instance Outputable JobResources where + ppr Jobs{..} + = text "JobResources" <+> + ( braces $ hsep + [ text "owned=" <> ppr tokensOwned + , text "free=" <> ppr tokensFree + , text "num_waiting=" <> ppr (length jobsWaiting) + ] ) + +-- | Add one new token. +addToken :: JobResources -> JobResources +addToken jobs@( Jobs { tokensOwned = owned, tokensFree = free }) + = --if owned > 6 then pprPanic "addToken" (ppr jobs) + -- else + jobs { tokensOwned = owned + 1, tokensFree = free + 1 } + +-- | Free one token. +addFreeToken :: JobResources -> JobResources +addFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (tokensOwned jobs > free) + (text "addFreeToken:" <+> ppr (tokensOwned jobs) <+> ppr free) + $ jobs { tokensFree = free + 1 } + +-- | Use up one token. +removeFreeToken :: JobResources -> JobResources +removeFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (free > 0) + (text "removeFreeToken:" <+> ppr free) + $ jobs { tokensFree = free - 1 } + +-- | Return one owned token. +removeOwnedToken :: JobResources -> JobResources +removeOwnedToken jobs@( Jobs { tokensOwned = owned }) + = assertPpr (owned > 1) + (text "removeOwnedToken:" <+> ppr owned) + $ jobs { tokensOwned = owned - 1 } + +-- | Add one new job to the end of the list of pending jobs. +addJob :: TMVar () -> JobResources -> JobResources +addJob job jobs@( Jobs { jobsWaiting = wait }) + = jobs { jobsWaiting = wait `SnocOL` job } + +-- | The state of the semaphore job server. +data JobserverState + = JobserverState + { jobserverAction :: !JobserverAction + -- ^ The current action being performed by the + -- job server. + , canChangeNumCaps :: !(TVar Bool) + -- ^ A TVar that signals whether it has been long + -- enough since we last changed 'numCapabilities'. + , canReleaseToken :: !(TVar Bool) + -- ^ A TVar that signals whether we last acquired + -- a token long enough ago that we can now release + -- a token. + } +data JobserverAction + -- | The jobserver is idle: no thread is currently + -- interacting with the semaphore. + = Idle + -- | A thread is waiting for a token on the semaphore. + | Acquiring + { activeWaitId :: WaitId + , threadFinished :: TMVar (Maybe MC.SomeException) } + +-- | Retrieve the 'TMVar' that signals if the current thread has finished, +-- if any thread is currently active in the jobserver. +activeThread_maybe :: JobserverAction -> Maybe (TMVar (Maybe MC.SomeException)) +activeThread_maybe Idle = Nothing +activeThread_maybe (Acquiring { threadFinished = tmvar }) = Just tmvar + +-- | Whether we should try to acquire a new token from the semaphore: +-- there is a pending job and no free tokens. +guardAcquire :: JobResources -> Bool +guardAcquire ( Jobs { tokensFree, jobsWaiting } ) + = tokensFree == 0 && not (null jobsWaiting) + +-- | Whether we should release a token from the semaphore: +-- there are no pending jobs and we can release a token. +guardRelease :: JobResources -> Bool +guardRelease ( Jobs { tokensFree, tokensOwned, jobsWaiting } ) + = null jobsWaiting && tokensFree > 0 && tokensOwned > 1 + +--------------------------------------- +-- Semaphore jobserver implementation + +-- | Add one pending job to the jobserver. +-- +-- Blocks, waiting on the jobserver to supply a free token. +acquireJob :: TVar JobResources -> IO () +acquireJob jobs_tvar = do + (job_tmvar, _jobs0) <- tracedAtomically "acquire" $ + modifyJobResources jobs_tvar \ jobs -> do + job_tmvar <- newEmptyTMVar + return ((job_tmvar, jobs), addJob job_tmvar jobs) + atomically $ takeTMVar job_tmvar + +-- | Signal to the job server that one job has completed, +-- releasing its corresponding token. +releaseJob :: TVar JobResources -> IO () +releaseJob jobs_tvar = do + tracedAtomically "release" do + modifyJobResources jobs_tvar \ jobs -> do + massertPpr (tokensFree jobs < tokensOwned jobs) + (text "releaseJob: more free jobs than owned jobs!") + return ((), addFreeToken jobs) + + +-- | Release all tokens owned from the semaphore (to clean up +-- the jobserver at the end). +cleanupJobserver :: Jobserver -> IO () +cleanupJobserver (Jobserver { jSemaphore = sem + , jobs = jobs_tvar }) + = do + Jobs { tokensOwned = owned } <- readTVarIO jobs_tvar + let toks_to_release = owned - 1 + -- Subtract off the implicit token: whoever spawned the ghc process + -- in the first place is responsible for that token. + releaseSemaphore sem toks_to_release + +-- | Dispatch the available tokens acquired from the semaphore +-- to the pending jobs in the job server. +dispatchTokens :: JobResources -> STM JobResources +dispatchTokens jobs@( Jobs { tokensFree = toks_free, jobsWaiting = wait } ) + | toks_free > 0 + , next `ConsOL` rest <- wait + -- There's a pending job and a free token: + -- pass on the token to that job, and recur. + = do + putTMVar next () + let jobs' = jobs { tokensFree = toks_free - 1, jobsWaiting = rest } + dispatchTokens jobs' + | otherwise + = return jobs + +-- | Update the available resources used from a semaphore, dispatching +-- any newly acquired resources. +-- +-- Invariant: if the number of available resources decreases, there +-- must be no pending jobs. +-- +-- All modifications should go through this function to ensure the contents +-- of the 'TVar' remains in normal form. +modifyJobResources :: HasCallStack => TVar JobResources + -> (JobResources -> STM (a, JobResources)) + -> STM (a, Maybe JobResources) +modifyJobResources jobs_tvar action = do + old_jobs <- readTVar jobs_tvar + (a, jobs) <- action old_jobs + + -- Check the invariant: if the number of free tokens has decreased, + -- there must be no pending jobs. + massertPpr (null (jobsWaiting jobs) || tokensFree jobs >= tokensFree old_jobs) $ + vcat [ text "modiyJobResources: pending jobs but fewer free tokens" ] + dispatched_jobs <- dispatchTokens jobs + writeTVar jobs_tvar dispatched_jobs + return (a, Just dispatched_jobs) + + +tracedAtomically_ :: String -> STM (Maybe JobResources) -> IO () +tracedAtomically_ s act = tracedAtomically s (((),) <$> act) + +tracedAtomically :: String -> STM (a, Maybe JobResources) -> IO a +tracedAtomically origin act = do + (a, mjr) <- atomically act + forM_ mjr $ \ jr -> do + -- Use the "jsem:" prefix to identify where the write traces are + traceEventIO ("jsem:" ++ renderJobResources origin jr) + return a + +renderJobResources :: String -> JobResources -> String +renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON $ + JSObject [ ("name", JSString origin) + , ("owned", JSInt own) + , ("free", JSInt free) + , ("pending", JSInt (length pending) ) + ] + + +-- | Spawn a new thread that waits on the semaphore in order to acquire +-- an additional token. +acquireThread :: Jobserver -> IO JobserverAction +acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + let + wait_result_action :: Either MC.SomeException Bool -> IO () + wait_result_action wait_res = + tracedAtomically_ "acquire_thread" do + (r, jb) <- case wait_res of + Left (e :: MC.SomeException) -> do + return $ (Just e, Nothing) + Right success -> do + if success + then do + modifyJobResources jobs_tvar \ jobs -> + return (Nothing, addToken jobs) + else + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jb + wait_id <- forkWaitOnSemaphoreInterruptible sem wait_result_action + labelThread (waitingThreadId wait_id) "acquire_thread" + return $ Acquiring { activeWaitId = wait_id + , threadFinished = threadFinished_tmvar } + +-- | Spawn a thread to release ownership of one resource from the semaphore, +-- provided we have spare resources and no pending jobs. +releaseThread :: Jobserver -> IO JobserverAction +releaseThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + MC.mask_ do + -- Pre-release the resource so that another thread doesn't take control of it + -- just as we release the lock on the semaphore. + still_ok_to_release + <- tracedAtomically "pre_release" $ + modifyJobResources jobs_tvar \ jobs -> + if guardRelease jobs + -- TODO: should this also debounce? + then return (True , removeOwnedToken $ removeFreeToken jobs) + else return (False, jobs) + if not still_ok_to_release + then return Idle + else do + tid <- forkIO $ do + x <- MC.try $ releaseSemaphore sem 1 + tracedAtomically_ "post-release" $ do + (r, jobs) <- case x of + Left (e :: MC.SomeException) -> do + modifyJobResources jobs_tvar \ jobs -> + return (Just e, addToken jobs) + Right _ -> do + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jobs + labelThread tid "release_thread" + return Idle + +-- | When there are pending jobs but no free tokens, +-- spawn a thread to acquire a new token from the semaphore. +-- +-- See 'acquireThread'. +tryAcquire :: JobserverOptions + -> Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryAcquire opts js@( Jobserver { jobs = jobs_tvar }) + st@( JobserverState { jobserverAction = Idle } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardAcquire jobs + return do + action <- acquireThread js + -- Set a debounce after acquiring a token. + can_release_tvar <- registerDelay $ (releaseDebounce opts * 1000) + return $ st { jobserverAction = action + , canReleaseToken = can_release_tvar } +tryAcquire _ _ _ = retry + +-- | When there are free tokens and no pending jobs, +-- spawn a thread to release a token from the semamphore. +-- +-- See 'releaseThread'. +tryRelease :: Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryRelease sjs@( Jobserver { jobs = jobs_tvar } ) + st@( JobserverState + { jobserverAction = Idle + , canReleaseToken = can_release_tvar } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardRelease jobs + can_release <- readTVar can_release_tvar + guard can_release + return do + action <- releaseThread sjs + return $ st { jobserverAction = action } +tryRelease _ _ = retry + +-- | Wait for an active thread to finish. Once it finishes: +-- +-- - set the 'JobserverAction' to 'Idle', +-- - update the number of capabilities to reflect the number +-- of owned tokens from the semaphore. +tryNoticeIdle :: JobserverOptions + -> TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryNoticeIdle opts jobs_tvar jobserver_state + | Just threadFinished_tmvar <- activeThread_maybe $ jobserverAction jobserver_state + = sync_num_caps (canChangeNumCaps jobserver_state) threadFinished_tmvar + | otherwise + = retry -- no active thread: wait until jobserver isn't idle + where + sync_num_caps :: TVar Bool + -> TMVar (Maybe MC.SomeException) + -> STM (IO JobserverState) + sync_num_caps can_change_numcaps_tvar threadFinished_tmvar = do + mb_ex <- takeTMVar threadFinished_tmvar + for_ mb_ex MC.throwM + Jobs { tokensOwned } <- readTVar jobs_tvar + can_change_numcaps <- readTVar can_change_numcaps_tvar + guard can_change_numcaps + return do + x <- getNumCapabilities + can_change_numcaps_tvar_2 <- + if x == tokensOwned + then return can_change_numcaps_tvar + else do + setNumCapabilities tokensOwned + registerDelay $ (setNumCapsDebounce opts * 1000) + return $ + jobserver_state + { jobserverAction = Idle + , canChangeNumCaps = can_change_numcaps_tvar_2 } + +-- | Try to stop the current thread which is acquiring/releasing resources +-- if that operation is no longer relevant. +tryStopThread :: TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryStopThread jobs_tvar jsj = do + case jobserverAction jsj of + Acquiring { activeWaitId = wait_id } -> do + jobs <- readTVar jobs_tvar + guard $ null (jobsWaiting jobs) + return do + interruptWaitOnSemaphore wait_id + return $ jsj { jobserverAction = Idle } + _ -> retry + +-- | Main jobserver loop: acquire/release resources as +-- needed for the pending jobs and available semaphore tokens. +jobserverLoop :: JobserverOptions -> Jobserver -> IO () +jobserverLoop opts sjs@(Jobserver { jobs = jobs_tvar }) + = do + true_tvar <- newTVarIO True + let init_state :: JobserverState + init_state = + JobserverState + { jobserverAction = Idle + , canChangeNumCaps = true_tvar + , canReleaseToken = true_tvar } + loop init_state + where + loop s = do + action <- atomically $ asum $ (\x -> x s) <$> + [ tryRelease sjs + , tryAcquire opts sjs + , tryNoticeIdle opts jobs_tvar + , tryStopThread jobs_tvar + ] + s <- action + loop s + +-- | Create a new jobserver using the given semaphore handle. +makeJobserver :: SemaphoreName -> IO (AbstractSem, IO ()) +makeJobserver sem_name = do + semaphore <- openSemaphore sem_name + let + init_jobs = + Jobs { tokensOwned = 1 + , tokensFree = 1 + , jobsWaiting = NilOL + } + jobs_tvar <- newTVarIO init_jobs + let + opts = defaultJobserverOptions -- TODO: allow this to be configured + sjs = Jobserver { jSemaphore = semaphore + , jobs = jobs_tvar } + loop_finished_mvar <- newEmptyMVar + loop_tid <- forkIOWithUnmask \ unmask -> do + r <- try $ unmask $ jobserverLoop opts sjs + putMVar loop_finished_mvar $ + case r of + Left e + | Just ThreadKilled <- fromException e + -> Nothing + | otherwise + -> Just e + Right () -> Nothing + labelThread loop_tid "job_server" + let + acquireSem = acquireJob jobs_tvar + releaseSem = releaseJob jobs_tvar + cleanupSem = do + -- this is interruptible + cleanupJobserver sjs + killThread loop_tid + mb_ex <- takeMVar loop_finished_mvar + for_ mb_ex MC.throwM + + return (AbstractSem{..}, cleanupSem) + +-- | Implement an abstract semaphore using a semaphore 'Jobserver' +-- which queries the system semaphore of the given name for resources. +runJSemAbstractSem :: SemaphoreName -- ^ the system semaphore to use + -> (AbstractSem -> IO a) -- ^ the operation to run + -- which requires a semaphore + -> IO a +runJSemAbstractSem sem action = MC.mask \ unmask -> do + (abs, cleanup) <- makeJobserver sem + r <- try $ unmask $ action abs + case r of + Left (e1 :: MC.SomeException) -> do + (_ :: Either MC.SomeException ()) <- MC.try cleanup + MC.throwM e1 + Right x -> cleanup $> x + +{- +Note [Architecture of the Job Server] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In `-jsem` mode, the amount of parallelism that GHC can use is controlled by a +system semaphore. We take resources from the semaphore when we need them, and +give them back if we don't have enough to do. + +A naive implementation would just take and release the semaphore around performing +the action, but this leads to two issues: + +* When taking a token in the semaphore, we must call `setNumCapabilities` in order + to adjust how many capabilities are available for parallel garbage collection. + This causes unnecessary synchronisations. +* We want to implement a debounce, so that whilst there is pending work in the + current process we prefer to keep hold of resources from the semaphore. + This reduces overall memory usage, as there are fewer live GHC processes at once. + +Therefore, the obtention of semaphore resources is separated away from the +request for the resource in the driver. + +A token from the semaphore is requested using `acquireJob`. This creates a pending +job, which is a MVar that can be filled in to signal that the requested token is ready. + +When the job is finished, the token is released by calling `releaseJob`, which just +increases the number of `free` jobs. If there are more pending jobs when the free count +is increased, the token is immediately reused (see `modifyJobResources`). + +The `jobServerLoop` interacts with the system semaphore: when there are pending +jobs, `acquireThread` blocks, waiting for a token from the semaphore. Once a +token is obtained, it increases the owned count. + +When GHC has free tokens (tokens from the semaphore that it is not using), +no pending jobs, and the debounce has expired, then `releaseThread` will +release tokens back to the global semaphore. + +`tryStopThread` attempts to kill threads which are waiting to acquire a resource +when we no longer need it. For example, consider that we attempt to acquire two +tokens, but the first job finishes before we acquire the second token. +This second token is no longer needed, so we should cancel the wait +(as it would not be used to do any work, and not be returned until the debounce). +We only need to kill `acquireJob`, because `releaseJob` never blocks. + +Note [Eventlog Messages for jsem] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +It can be tricky to verify that the work is shared adequately across different +processes. To help debug this, we output the values of `JobResource` to the +eventlog whenever the global state changes. There are some scripts which can be used +to analyse this output and report statistics about core saturation in the +GitHub repo (https://github.com/mpickering/ghc-jsem-analyse). + +-} ===================================== compiler/GHC/Driver/Pipeline/LogQueue.hs ===================================== @@ -100,10 +100,10 @@ dequeueLogQueueQueue (LogQueueQueue n lqq) = case IM.minViewWithKey lqq of Just ((k, v), lqq') | k == n -> Just (v, LogQueueQueue (n + 1) lqq') _ -> Nothing -logThread :: Int -> Int -> Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit +logThread :: Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit -> TVar LogQueueQueue -- Queue for logs -> IO (IO ()) -logThread _ _ logger stopped lqq_var = do +logThread logger stopped lqq_var = do finished_var <- newEmptyMVar _ <- forkIO $ print_logs *> putMVar finished_var () return (takeMVar finished_var) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -43,6 +43,7 @@ module GHC.Driver.Session ( needSourceNotes, OnOff(..), DynFlags(..), + ParMakeCount(..), outputFile, objectSuf, ways, FlagSpec(..), HasDynFlags(..), ContainsDynFlags(..), @@ -461,9 +462,13 @@ data DynFlags = DynFlags { ruleCheck :: Maybe String, strictnessBefore :: [Int], -- ^ Additional demand analysis - parMakeCount :: Maybe Int, -- ^ The number of modules to compile in parallel - -- in --make mode, where Nothing ==> compile as - -- many in parallel as there are CPUs. + parMakeCount :: Maybe ParMakeCount, + -- ^ The number of modules to compile in parallel + -- in --make mode, ignored with a warning if jobServerAuth is specified. + -- If unspecified, compile with a single job. + + jsemHandle :: Maybe FilePath, + -- ^ A handle to a parallelism semaphore enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? ghcHeapSize :: Maybe Int, -- ^ The heap size to set. @@ -783,6 +788,12 @@ instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where class ContainsDynFlags t where extractDynFlags :: t -> DynFlags +-- | The type for the -jN argument, specifying that -j on its own represents +-- using the number of machine processors. +data ParMakeCount + = ParMakeThisMany Int + | ParMakeNumProcessors + ----------------------------------------------------------------------------- -- Accessors from 'DynFlags' @@ -1146,7 +1157,8 @@ defaultDynFlags mySettings = historySize = 20, strictnessBefore = [], - parMakeCount = Just 1, + parMakeCount = Nothing, + jsemHandle = Nothing, enableTimeStats = False, ghcHeapSize = Nothing, @@ -1914,19 +1926,25 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do throwGhcExceptionIO (CmdLineError ("combination not supported: " ++ intercalate "/" (map wayDesc (Set.toAscList theWays)))) - let (dflags3, consistency_warnings) = makeDynFlagsConsistent dflags2 + (dflags3, io_warnings) <- liftIO $ dynFlagsIOCheck dflags2 + + let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3 -- Set timer stats & heap size - when (enableTimeStats dflags3) $ liftIO enableTimingStats - case (ghcHeapSize dflags3) of + when (enableTimeStats dflags4) $ liftIO enableTimingStats + case (ghcHeapSize dflags4) of Just x -> liftIO (setHeapSize x) _ -> return () - liftIO $ setUnsafeGlobalDynFlags dflags3 + liftIO $ setUnsafeGlobalDynFlags dflags4 - let warns' = map (Warn WarningWithoutFlag) (consistency_warnings ++ sh_warns) + let warns' = map (Warn WarningWithoutFlag) (consistency_warnings ++ sh_warns ++ io_warnings) - return (dflags3, leftover, warns' ++ warns) + return (dflags4, leftover, warns' ++ warns) + +-- | Perform checks and fixes on DynFlags which require IO +dynFlagsIOCheck :: DynFlags -> IO (DynFlags, [Located String]) +dynFlagsIOCheck dflags = pure (dflags, []) -- | Check (and potentially disable) any extensions that aren't allowed -- in safe mode. @@ -2066,14 +2084,16 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "j" (OptIntSuffix (\n -> case n of Just n - | n > 0 -> upd (\d -> d { parMakeCount = Just n }) + | n > 0 -> upd (\d -> d { parMakeCount = Just (ParMakeThisMany n) }) | otherwise -> addErr "Syntax: -j[n] where n > 0" - Nothing -> upd (\d -> d { parMakeCount = Nothing }))) + Nothing -> upd (\d -> d { parMakeCount = Just ParMakeNumProcessors }))) -- When the number of parallel builds -- is omitted, it is the same -- as specifying that the number of -- parallel builds is equal to the -- result of getNumProcessors + , make_ord_flag defGhcFlag "jsem" $ hasArg $ \f d -> d { jsemHandle = Just f } + , make_ord_flag defFlag "instantiated-with" (sepArg setUnitInstantiations) , make_ord_flag defFlag "this-component-id" (sepArg setUnitInstanceOf) @@ -4886,6 +4906,11 @@ makeDynFlagsConsistent dflags , Nothing <- outputFile dflags = pgmError "--output must be specified when using --merge-objs" + | Just _ <- jsemHandle dflags + , Just _ <- parMakeCount dflags + = loop dflags{parMakeCount = Nothing} + "`-j` argument is ignored when using `-jsem`" + | otherwise = (dflags, []) where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") loop updated_dflags warning ===================================== compiler/ghc.cabal.in ===================================== @@ -85,6 +85,7 @@ Library hpc == 0.6.*, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, + semaphore-compat, stm, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, @@ -436,6 +437,7 @@ Library GHC.Driver.GenerateCgIPEStub GHC.Driver.Hooks GHC.Driver.LlvmConfigCache + GHC.Driver.MakeSem GHC.Driver.Main GHC.Driver.Make GHC.Driver.MakeFile ===================================== docs/users_guide/using.rst ===================================== @@ -751,6 +751,14 @@ search path (see :ref:`search-path`). number of processors. Note that compilation of a module may not begin until its dependencies have been built. +.. ghc-flag:: -jsem + :shortdesc: stub + :type: dynamic + :category: misc + + Stub + + .. _multi-home-units: Multiple Home Units ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -39,7 +39,7 @@ ghcPackages = , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl - , parsec, pretty, process, rts, runGhc, stm, templateHaskell + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon @@ -55,7 +55,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, - parsec, pretty, primitive, process, rts, runGhc, stm, templateHaskell, + parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -110,6 +110,7 @@ process = lib "process" remoteIserv = util "remote-iserv" rts = top "rts" runGhc = util "runghc" +semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" terminfo = lib "terminfo" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -171,6 +171,7 @@ toolTargets = [ binary , templateHaskell , text , transformers + , semaphoreCompat , unlit -- # executable ] ++ if windowsHost then [ win32 ] else [ unix ] ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -95,6 +95,7 @@ stage0Packages = do , hpcBin , mtl , parsec + , semaphoreCompat , time , templateHaskell , text @@ -142,6 +143,7 @@ stage1Packages = do , integerGmp , pretty , rts + , semaphoreCompat , stm , unlit , xhtml ===================================== libraries/Win32 ===================================== @@ -1 +1 @@ -Subproject commit 931497f7052f63cb5cfd4494a94e572c5c570642 +Subproject commit efab7f1146da9741dc54fb35476d4aaabeff8d6d ===================================== libraries/ghc-bignum/ghc-bignum.cabal ===================================== @@ -89,8 +89,6 @@ library -- "ghc-bignum" and not "ghc-bignum-1.0". ghc-options: -this-unit-id ghc-bignum - include-dirs: include - if flag(gmp) cpp-options: -DBIGNUM_GMP other-modules: ===================================== libraries/semaphore-compat ===================================== @@ -0,0 +1 @@ +Subproject commit 663ef75467995acf41c51d3e21d03347e85b844e ===================================== packages ===================================== @@ -65,5 +65,6 @@ libraries/Win32 - - https:/ libraries/xhtml - - https://github.com/haskell/xhtml.git libraries/exceptions - - https://github.com/ekmett/exceptions.git nofib nofib - - +libraries/semaphore-compat - - - libraries/stm - - ssh://git at github.com/haskell/stm.git . - ghc.git - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6b241e1aa48b29bb5fc5127cb35ceb92d1c44523...1afc60248569c699cbefc02911e4df87f0733496 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6b241e1aa48b29bb5fc5127cb35ceb92d1c44523...1afc60248569c699cbefc02911e4df87f0733496 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 12:27:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 16 Mar 2023 08:27:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: ghc-bignum: Drop redundant include-dirs field Message-ID: <64130b42484e_37e76b366ecc70457278@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - 148eff77 by Teo Camarasu at 2023-03-16T08:27:38-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 0bf8bfff by Teo Camarasu at 2023-03-16T08:27:38-04:00 Add changelog entry for #23049 - - - - - 148d155c by Ben Gamari at 2023-03-16T08:27:39-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 6 changed files: - compiler/GHC/Driver/Config.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Interpreter.hs - docs/users_guide/9.8.1-notes.rst - libraries/ghc-bignum/ghc-bignum.cabal - m4/fp_find_cxx_std_lib.m4 Changes: ===================================== compiler/GHC/Driver/Config.hs ===================================== @@ -2,7 +2,6 @@ module GHC.Driver.Config ( initOptCoercionOpts , initSimpleOpts - , initBCOOpts , initEvalOpts ) where @@ -12,12 +11,8 @@ import GHC.Prelude import GHC.Driver.Session import GHC.Core.SimpleOpt import GHC.Core.Coercion.Opt -import GHC.Runtime.Interpreter (BCOOpts(..)) import GHCi.Message (EvalOpts(..)) -import GHC.Conc (getNumProcessors) -import Control.Monad.IO.Class - -- | Initialise coercion optimiser configuration from DynFlags initOptCoercionOpts :: DynFlags -> OptCoercionOpts initOptCoercionOpts dflags = OptCoercionOpts @@ -32,16 +27,6 @@ initSimpleOpts dflags = SimpleOpts , so_eta_red = gopt Opt_DoEtaReduction dflags } --- | Extract BCO options from DynFlags -initBCOOpts :: DynFlags -> IO BCOOpts -initBCOOpts dflags = do - -- Serializing ResolvedBCO is expensive, so if we're in parallel mode - -- (-j) parallelise the serialization. - n_jobs <- case parMakeCount dflags of - Nothing -> liftIO getNumProcessors - Just n -> return n - return $ BCOOpts n_jobs - -- | Extract GHCi options from DynFlags and step initEvalOpts :: DynFlags -> Bool -> EvalOpts initEvalOpts dflags step = ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -43,7 +43,6 @@ import GHC.Driver.Phases import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Ppr -import GHC.Driver.Config import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Finder @@ -598,8 +597,7 @@ loadExpr interp hsc_env span root_ul_bco = do nobreakarray = error "no break array" bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)] resolved <- linkBCO interp le bco_ix nobreakarray root_ul_bco - bco_opts <- initBCOOpts (hsc_dflags hsc_env) - [root_hvref] <- createBCOs interp bco_opts [resolved] + [root_hvref] <- createBCOs interp [resolved] fhv <- mkFinalizedHValue interp root_hvref return (pls, fhv) where @@ -946,8 +944,7 @@ loadDecls interp hsc_env span cbc at CompiledByteCode{..} = do , addr_env = plusNameEnv (addr_env le) bc_strs } -- Link the necessary packages and linkables - bco_opts <- initBCOOpts (hsc_dflags hsc_env) - new_bindings <- linkSomeBCOs bco_opts interp le2 [cbc] + new_bindings <- linkSomeBCOs interp le2 [cbc] nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings let ce2 = extendClosureEnv (closure_env le2) nms_fhvs !pls2 = pls { linker_env = le2 { closure_env = ce2 } } @@ -995,7 +992,6 @@ loadModuleLinkables interp hsc_env pls linkables let (objs, bcos) = partition isObjectLinkable (concatMap partitionLinkable linkables) - bco_opts <- initBCOOpts (hsc_dflags hsc_env) -- Load objects first; they can't depend on BCOs (pls1, ok_flag) <- loadObjects interp hsc_env pls objs @@ -1003,7 +999,7 @@ loadModuleLinkables interp hsc_env pls linkables if failed ok_flag then return (pls1, Failed) else do - pls2 <- dynLinkBCOs bco_opts interp pls1 bcos + pls2 <- dynLinkBCOs interp pls1 bcos return (pls2, Succeeded) @@ -1156,8 +1152,8 @@ rmDupLinkables already ls ********************************************************************* -} -dynLinkBCOs :: BCOOpts -> Interp -> LoaderState -> [Linkable] -> IO LoaderState -dynLinkBCOs bco_opts interp pls bcos = do +dynLinkBCOs :: Interp -> LoaderState -> [Linkable] -> IO LoaderState +dynLinkBCOs interp pls bcos = do let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos pls1 = pls { bcos_loaded = bcos_loaded' } @@ -1173,7 +1169,7 @@ dynLinkBCOs bco_opts interp pls bcos = do ae2 = foldr plusNameEnv (addr_env le1) (map bc_strs cbcs) le2 = le1 { itbl_env = ie2, addr_env = ae2 } - names_and_refs <- linkSomeBCOs bco_opts interp le2 cbcs + names_and_refs <- linkSomeBCOs interp le2 cbcs -- We only want to add the external ones to the ClosureEnv let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs @@ -1187,8 +1183,7 @@ dynLinkBCOs bco_opts interp pls bcos = do return $! pls1 { linker_env = le2 { closure_env = ce2 } } -- Link a bunch of BCOs and return references to their values -linkSomeBCOs :: BCOOpts - -> Interp +linkSomeBCOs :: Interp -> LinkerEnv -> [CompiledByteCode] -> IO [(Name,HValueRef)] @@ -1196,7 +1191,7 @@ linkSomeBCOs :: BCOOpts -- the incoming unlinked BCOs. Each gives the -- value of the corresponding unlinked BCO -linkSomeBCOs bco_opts interp le mods = foldr fun do_link mods [] +linkSomeBCOs interp le mods = foldr fun do_link mods [] where fun CompiledByteCode{..} inner accum = case bc_breaks of @@ -1211,7 +1206,7 @@ linkSomeBCOs bco_opts interp le mods = foldr fun do_link mods [] bco_ix = mkNameEnv (zip names [0..]) resolved <- sequence [ linkBCO interp le bco_ix breakarray bco | (breakarray, bco) <- flat ] - hvrefs <- createBCOs interp bco_opts resolved + hvrefs <- createBCOs interp resolved return (zip names hvrefs) -- | Useful to apply to the result of 'linkSomeBCOs' ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -11,7 +11,6 @@ module GHC.Runtime.Interpreter ( module GHC.Runtime.Interpreter.Types -- * High-level interface to the interpreter - , BCOOpts (..) , evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..) , resumeStmt , abandonStmt @@ -329,26 +328,11 @@ mkCostCentres :: Interp -> String -> [(String,String)] -> IO [RemotePtr CostCent mkCostCentres interp mod ccs = interpCmd interp (MkCostCentres mod ccs) -newtype BCOOpts = BCOOpts - { bco_n_jobs :: Int -- ^ Number of parallel jobs doing BCO serialization - } - -- | Create a set of BCOs that may be mutually recursive. -createBCOs :: Interp -> BCOOpts -> [ResolvedBCO] -> IO [HValueRef] -createBCOs interp opts rbcos = do - let n_jobs = bco_n_jobs opts - -- Serializing ResolvedBCO is expensive, so if we support doing it in parallel - if (n_jobs == 1) - then - interpCmd interp (CreateBCOs [runPut (put rbcos)]) - else do - old_caps <- getNumCapabilities - if old_caps == n_jobs - then void $ evaluate puts - else bracket_ (setNumCapabilities n_jobs) - (setNumCapabilities old_caps) - (void $ evaluate puts) - interpCmd interp (CreateBCOs puts) +createBCOs :: Interp -> [ResolvedBCO] -> IO [HValueRef] +createBCOs interp rbcos = do + -- Serializing ResolvedBCO is expensive, so we do it in parallel + interpCmd interp (CreateBCOs puts) where puts = parMap doChunk (chunkList 100 rbcos) ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -32,6 +32,9 @@ Compiler the specification described in the documentation of the `INCOHERENT` pragma. See GHC ticket #22448 for further details. +- Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``. + See GHC ticket #23049. + GHCi ~~~~ ===================================== libraries/ghc-bignum/ghc-bignum.cabal ===================================== @@ -89,8 +89,6 @@ library -- "ghc-bignum" and not "ghc-bignum-1.0". ghc-options: -this-unit-id ghc-bignum - include-dirs: include - if flag(gmp) cpp-options: -DBIGNUM_GMP other-modules: ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -4,6 +4,14 @@ # Identify which C++ standard library implementation the C++ toolchain links # against. AC_DEFUN([FP_FIND_CXX_STD_LIB],[ + # Annoyingly, Darwin's includes and APFS is + # case-insensitive. Consequently, it will end up #including the + # VERSION file generated by the configure script on the second + # and subsequent runs of the configure script. + # See #23116. + mkdir -p actest.tmp + cd actest.tmp + # If this is non-empty then assume that the user has specified these # manually. if test -z "$CXX_STD_LIB_LIBS"; then @@ -87,6 +95,9 @@ EOF rm -f actest.cpp actest.o actest fi + cd .. + rm -R actest.tmp + AC_SUBST([CXX_STD_LIB_LIBS]) AC_SUBST([CXX_STD_LIB_LIB_DIRS]) AC_SUBST([CXX_STD_LIB_DYN_LIB_DIRS]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4fb1cc2a7132e6cbc860d04416881f4ec83f033c...148d155cf7da201cbec96be9b5686f8441fd8492 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4fb1cc2a7132e6cbc860d04416881f4ec83f033c...148d155cf7da201cbec96be9b5686f8441fd8492 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 12:39:52 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 16 Mar 2023 08:39:52 -0400 Subject: [Git][ghc/ghc][wip/exception-context] 144 commits: Don't generate datacon wrappers for `type data` declarations Message-ID: <64130e18af00b_37e76b36ab101846677@gitlab.mail> Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC Commits: 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 31a48a6b by Ben Gamari at 2023-03-15T22:58:49-04:00 compiler/tc: Small optimisation of evCallStack Don't lookupIds unless we actually need them. - - - - - 47fc6ca6 by Ben Gamari at 2023-03-15T22:58:56-04:00 compiler/tc: Use toException instead of SomeException - - - - - 1974d343 by Ben Gamari at 2023-03-15T22:59:00-04:00 base: Factor out errorBelch This was useful when debugging - - - - - b9c9c031 by Ben Gamari at 2023-03-15T22:59:00-04:00 base: Clean up imports of GHC.ExecutionStack - - - - - f3d2cb5e by Ben Gamari at 2023-03-15T22:59:00-04:00 base: Clean up imports of GHC.Stack.CloneStack - - - - - 1507bcf6 by Ben Gamari at 2023-03-15T22:59:00-04:00 base: Move prettyCallStack to GHC.Stack - - - - - 9ad34238 by Ben Gamari at 2023-03-15T22:59:00-04:00 base: Move PrimMVar to GHC.MVar - - - - - e94fbc3d by Ben Gamari at 2023-03-15T22:59:00-04:00 base: Use displayException in top-level exception handler Happily this also allows us to eliminate a special case for Deadlock exceptions. - - - - - 8e8676f1 by Ben Gamari at 2023-03-16T08:39:40-04:00 base: Introduce exception context - - - - - 47c5db57 by Ben Gamari at 2023-03-16T08:39:40-04:00 Drop redundant import - - - - - c39cf782 by Ben Gamari at 2023-03-16T08:39:46-04:00 compiler: Default and warn ExceptionContext constraints - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/test-metrics.sh - .gitmodules - compiler/GHC/Builtin/Names.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Binds.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c563563f247196096414023d36f9fdf9a5d60ea1...c39cf7827eb4f96ce27efa784440f19514abc919 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c563563f247196096414023d36f9fdf9a5d60ea1...c39cf7827eb4f96ce27efa784440f19514abc919 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 12:46:13 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 16 Mar 2023 08:46:13 -0400 Subject: [Git][ghc/ghc][wip/jsem] Implement -jsem: parallelism controlled by semaphores Message-ID: <64130f956a740_37e76b36f1245446691@gitlab.mail> Matthew Pickering pushed to branch wip/jsem at Glasgow Haskell Compiler / GHC Commits: 223cefde by sheaf at 2023-03-16T12:45:59+00:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Fixes #19349 - - - - - 14 changed files: - .gitmodules - cabal.project-reinstall - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/ghc.cabal.in - docs/users_guide/using.rst - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - + libraries/semaphore-compat - packages Changes: ===================================== .gitmodules ===================================== @@ -83,6 +83,10 @@ url = https://gitlab.haskell.org/ghc/packages/unix.git ignore = untracked branch = 2.7 +[submodule "libraries/semaphore-compat"] + path = libraries/semaphore-compat + url = https://gitlab.haskell.org/ghc/semaphore-compat.git + ignore = untracked [submodule "libraries/stm"] path = libraries/stm url = https://gitlab.haskell.org/ghc/packages/stm.git ===================================== cabal.project-reinstall ===================================== @@ -28,6 +28,7 @@ packages: ./compiler ./libraries/parsec/ -- ./libraries/pretty/ ./libraries/process/ + ./libraries/semaphore-compat ./libraries/stm -- ./libraries/template-haskell/ ./libraries/terminfo/ ===================================== compiler/GHC/Driver/Config.hs ===================================== @@ -38,8 +38,9 @@ initBCOOpts dflags = do -- Serializing ResolvedBCO is expensive, so if we're in parallel mode -- (-j) parallelise the serialization. n_jobs <- case parMakeCount dflags of - Nothing -> liftIO getNumProcessors - Just n -> return n + Nothing -> pure 1 + Just (ParMakeThisMany n) -> pure n + Just ParMakeNumProcessors -> liftIO getNumProcessors return $ BCOOpts n_jobs -- | Extract GHCi options from DynFlags and step ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -75,6 +75,7 @@ import GHC.Driver.Env import GHC.Driver.Errors import GHC.Driver.Errors.Types import GHC.Driver.Main +import GHC.Driver.MakeSem import GHC.Parser.Header @@ -149,9 +150,9 @@ import GHC.Runtime.Loader import GHC.Rename.Names import GHC.Utils.Constants import GHC.Types.Unique.DFM (udfmRestrictKeysSet) -import qualified Data.IntSet as I import GHC.Types.Unique +import qualified Data.IntSet as I -- ----------------------------------------------------------------------------- -- Loading the program @@ -657,6 +658,31 @@ createBuildPlan mod_graph maybe_top_mod = (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (length (mgModSummaries' mod_graph )))]) build_plan +mkWorkerLimit :: DynFlags -> IO WorkerLimit +mkWorkerLimit dflags = + case jsemHandle dflags of + Just h -> pure (JSemLimit $ SemaphoreName h) + Nothing -> case parMakeCount dflags of + Nothing -> pure $ num_procs 1 + Just ParMakeNumProcessors -> num_procs <$> getNumProcessors + Just (ParMakeThisMany n) -> pure $ num_procs n + where + num_procs x = NumProcessorsLimit (max 1 x) + +isWorkerLimitSequential :: WorkerLimit -> Bool +isWorkerLimitSequential (NumProcessorsLimit x) = x <= 1 +isWorkerLimitSequential (JSemLimit {}) = False + +-- | This describes what we use to limit the number of jobs, either we limit it +-- ourselves to a specific number or we have an external parallelism semaphore +-- limit it for us. +data WorkerLimit + = NumProcessorsLimit Int + | JSemLimit + SemaphoreName + -- ^ Semaphore name to use + deriving Eq + -- | Generalized version of 'load' which also supports a custom -- 'Messager' (for reporting progress) and 'ModuleGraph' (generally -- produced by calling 'depanal'. @@ -737,14 +763,12 @@ load' mhmi_cache how_much mHscMessage mod_graph = do liftIO $ debugTraceMsg logger 2 (hang (text "Ready for upsweep") 2 (ppr build_plan)) - n_jobs <- case parMakeCount (hsc_dflags hsc_env) of - Nothing -> liftIO getNumProcessors - Just n -> return n + worker_limit <- liftIO $ mkWorkerLimit dflags setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do hsc_env <- getSession - liftIO $ upsweep n_jobs hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan + liftIO $ upsweep worker_limit hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan setSession hsc_env1 case upsweep_ok of Failed -> loadFinish upsweep_ok @@ -1029,13 +1053,7 @@ getDependencies direct_deps build_map = type BuildM a = StateT BuildLoopState IO a --- | Abstraction over the operations of a semaphore which allows usage with the --- -j1 case -data AbstractSem = AbstractSem { acquireSem :: IO () - , releaseSem :: IO () } -withAbstractSem :: AbstractSem -> IO b -> IO b -withAbstractSem sem = MC.bracket_ (acquireSem sem) (releaseSem sem) -- | Environment used when compiling a module data MakeEnv = MakeEnv { hsc_env :: !HscEnv -- The basic HscEnv which will be augmented for each module @@ -1220,7 +1238,7 @@ withCurrentUnit uid = do local (\env -> env { hsc_env = hscSetActiveUnitId uid (hsc_env env)}) upsweep - :: Int -- ^ The number of workers we wish to run in parallel + :: WorkerLimit -- ^ The number of workers we wish to run in parallel -> HscEnv -- ^ The base HscEnv, which is augmented for each module -> Maybe ModIfaceCache -- ^ A cache to incrementally write final interface files to -> Maybe Messager @@ -2825,7 +2843,7 @@ label_self thread_name = do CC.labelThread self_tid thread_name -runPipelines :: Int -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () +runPipelines :: WorkerLimit -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () -- Don't even initialise plugins if there are no pipelines runPipelines _ _ _ [] = return () runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do @@ -2833,7 +2851,7 @@ runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do plugins_hsc_env <- initializePlugins orig_hsc_env case n_job of - 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines + NumProcessorsLimit n | n <= 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines _n -> runParPipelines n_job plugins_hsc_env mHscMessager all_pipelines runSeqPipelines :: HscEnv -> Maybe Messager -> [MakeAction] -> IO () @@ -2843,16 +2861,38 @@ runSeqPipelines plugin_hsc_env mHscMessager all_pipelines = , compile_sem = AbstractSem (return ()) (return ()) , env_messager = mHscMessager } - in runAllPipelines 1 env all_pipelines + in runAllPipelines (NumProcessorsLimit 1) env all_pipelines +runNjobsAbstractSem :: Int -> (AbstractSem -> IO a) -> IO a +runNjobsAbstractSem n_jobs action = do + compile_sem <- newQSem n_jobs + n_capabilities <- getNumCapabilities + n_cpus <- getNumProcessors + let + asem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + set_num_caps n = unless (n_capabilities /= 1) $ setNumCapabilities n + updNumCapabilities = do + -- Setting number of capabilities more than + -- CPU count usually leads to high userspace + -- lock contention. #9221 + set_num_caps $ min n_jobs n_cpus + resetNumCapabilities = set_num_caps n_capabilities + MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem + +runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a +runWorkerLimit worker_limit action = case worker_limit of + NumProcessorsLimit n_jobs -> + runNjobsAbstractSem n_jobs action + JSemLimit sem -> + runJSemAbstractSem sem action -- | Build and run a pipeline -runParPipelines :: Int -- ^ How many capabilities to use - -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module +runParPipelines :: WorkerLimit -- ^ How to limit work parallelism + -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module -> Maybe Messager -- ^ Optional custom messager to use to report progress -> [MakeAction] -- ^ The build plan for all the module nodes -> IO () -runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do +runParPipelines worker_limit plugin_hsc_env mHscMessager all_pipelines = do -- A variable which we write to when an error has happened and we have to tell the @@ -2862,39 +2902,23 @@ runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do -- will add it's LogQueue into this queue. log_queue_queue_var <- newTVarIO newLogQueueQueue -- Thread which coordinates the printing of logs - wait_log_thread <- logThread n_jobs (length all_pipelines) (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var + wait_log_thread <- logThread (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var -- Make the logger thread-safe, in case there is some output which isn't sent via the LogQueue. thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env) let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger } - let updNumCapabilities = liftIO $ do - n_capabilities <- getNumCapabilities - n_cpus <- getNumProcessors - -- Setting number of capabilities more than - -- CPU count usually leads to high userspace - -- lock contention. #9221 - let n_caps = min n_jobs n_cpus - unless (n_capabilities /= 1) $ setNumCapabilities n_caps - return n_capabilities - - let resetNumCapabilities orig_n = do - liftIO $ setNumCapabilities orig_n - atomically $ writeTVar stopped_var True - wait_log_thread - - compile_sem <- newQSem n_jobs - let abstract_sem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + runWorkerLimit worker_limit $ \abstract_sem -> do + let env = MakeEnv { hsc_env = thread_safe_hsc_env + , withLogger = withParLog log_queue_queue_var + , compile_sem = abstract_sem + , env_messager = mHscMessager + } -- Reset the number of capabilities once the upsweep ends. - let env = MakeEnv { hsc_env = thread_safe_hsc_env - , withLogger = withParLog log_queue_queue_var - , compile_sem = abstract_sem - , env_messager = mHscMessager - } - - MC.bracket updNumCapabilities resetNumCapabilities $ \_ -> - runAllPipelines n_jobs env all_pipelines + runAllPipelines worker_limit env all_pipelines + atomically $ writeTVar stopped_var True + wait_log_thread withLocalTmpFS :: RunMakeM a -> RunMakeM a withLocalTmpFS act = do @@ -2911,10 +2935,11 @@ withLocalTmpFS act = do MC.bracket initialiser finaliser $ \lcl_hsc_env -> local (\env -> env { hsc_env = lcl_hsc_env}) act -- | Run the given actions and then wait for them all to finish. -runAllPipelines :: Int -> MakeEnv -> [MakeAction] -> IO () -runAllPipelines n_jobs env acts = do - let spawn_actions :: IO [ThreadId] - spawn_actions = if n_jobs == 1 +runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO () +runAllPipelines worker_limit env acts = do + let single_worker = isWorkerLimitSequential worker_limit + spawn_actions :: IO [ThreadId] + spawn_actions = if single_worker then (:[]) <$> (forkIOWithUnmask $ \unmask -> void $ runLoop (\io -> io unmask) env acts) else runLoop forkIOWithUnmask env acts ===================================== compiler/GHC/Driver/MakeSem.hs ===================================== @@ -0,0 +1,548 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE NumericUnderscores #-} + +-- | Implementation of a jobserver using system semaphores. +-- +-- +module GHC.Driver.MakeSem + ( -- * JSem: parallelism semaphore backed + -- by a system semaphore (Posix/Windows) + runJSemAbstractSem + + -- * System semaphores + , Semaphore, SemaphoreName(..) + + -- * Abstract semaphores + , AbstractSem(..) + , withAbstractSem + ) + where + +import GHC.Prelude +import GHC.Conc +import GHC.Data.OrdList +import GHC.IO.Exception +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Json + +import System.Semaphore + +import Control.Monad +import qualified Control.Monad.Catch as MC +import Control.Concurrent.MVar +import Control.Concurrent.STM +import Data.Foldable +import Data.Functor +import GHC.Stack +import Debug.Trace + +--------------------------------------- +-- Semaphore jobserver + +-- | A jobserver based off a system 'Semaphore'. +-- +-- Keeps track of the pending jobs and resources +-- available from the semaphore. +data Jobserver + = Jobserver + { jSemaphore :: !Semaphore + -- ^ The semaphore which controls available resources + , jobs :: !(TVar JobResources) + -- ^ The currently pending jobs, and the resources + -- obtained from the semaphore + } + +data JobserverOptions + = JobserverOptions + { releaseDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between acquiring a token + -- and releasing a token. + , setNumCapsDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between two consecutive + -- calls of 'setNumCapabilities'. + } + +defaultJobserverOptions :: JobserverOptions +defaultJobserverOptions = + JobserverOptions + { releaseDebounce = 1000 -- 1 second + , setNumCapsDebounce = 1000 -- 1 second + } + +-- | Resources available for running jobs, i.e. +-- tokens obtained from the parallelism semaphore. +data JobResources + = Jobs + { tokensOwned :: !Int + -- ^ How many tokens have been claimed from the semaphore + , tokensFree :: !Int + -- ^ How many tokens are not currently being used + , jobsWaiting :: !(OrdList (TMVar ())) + -- ^ Pending jobs waiting on a token, the job will be blocked on the TMVar so putting into + -- the TMVar will allow the job to continue. + } + +instance Outputable JobResources where + ppr Jobs{..} + = text "JobResources" <+> + ( braces $ hsep + [ text "owned=" <> ppr tokensOwned + , text "free=" <> ppr tokensFree + , text "num_waiting=" <> ppr (length jobsWaiting) + ] ) + +-- | Add one new token. +addToken :: JobResources -> JobResources +addToken jobs@( Jobs { tokensOwned = owned, tokensFree = free }) + = jobs { tokensOwned = owned + 1, tokensFree = free + 1 } + +-- | Free one token. +addFreeToken :: JobResources -> JobResources +addFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (tokensOwned jobs > free) + (text "addFreeToken:" <+> ppr (tokensOwned jobs) <+> ppr free) + $ jobs { tokensFree = free + 1 } + +-- | Use up one token. +removeFreeToken :: JobResources -> JobResources +removeFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (free > 0) + (text "removeFreeToken:" <+> ppr free) + $ jobs { tokensFree = free - 1 } + +-- | Return one owned token. +removeOwnedToken :: JobResources -> JobResources +removeOwnedToken jobs@( Jobs { tokensOwned = owned }) + = assertPpr (owned > 1) + (text "removeOwnedToken:" <+> ppr owned) + $ jobs { tokensOwned = owned - 1 } + +-- | Add one new job to the end of the list of pending jobs. +addJob :: TMVar () -> JobResources -> JobResources +addJob job jobs@( Jobs { jobsWaiting = wait }) + = jobs { jobsWaiting = wait `SnocOL` job } + +-- | The state of the semaphore job server. +data JobserverState + = JobserverState + { jobserverAction :: !JobserverAction + -- ^ The current action being performed by the + -- job server. + , canChangeNumCaps :: !(TVar Bool) + -- ^ A TVar that signals whether it has been long + -- enough since we last changed 'numCapabilities'. + , canReleaseToken :: !(TVar Bool) + -- ^ A TVar that signals whether we last acquired + -- a token long enough ago that we can now release + -- a token. + } +data JobserverAction + -- | The jobserver is idle: no thread is currently + -- interacting with the semaphore. + = Idle + -- | A thread is waiting for a token on the semaphore. + | Acquiring + { activeWaitId :: WaitId + , threadFinished :: TMVar (Maybe MC.SomeException) } + +-- | Retrieve the 'TMVar' that signals if the current thread has finished, +-- if any thread is currently active in the jobserver. +activeThread_maybe :: JobserverAction -> Maybe (TMVar (Maybe MC.SomeException)) +activeThread_maybe Idle = Nothing +activeThread_maybe (Acquiring { threadFinished = tmvar }) = Just tmvar + +-- | Whether we should try to acquire a new token from the semaphore: +-- there is a pending job and no free tokens. +guardAcquire :: JobResources -> Bool +guardAcquire ( Jobs { tokensFree, jobsWaiting } ) + = tokensFree == 0 && not (null jobsWaiting) + +-- | Whether we should release a token from the semaphore: +-- there are no pending jobs and we can release a token. +guardRelease :: JobResources -> Bool +guardRelease ( Jobs { tokensFree, tokensOwned, jobsWaiting } ) + = null jobsWaiting && tokensFree > 0 && tokensOwned > 1 + +--------------------------------------- +-- Semaphore jobserver implementation + +-- | Add one pending job to the jobserver. +-- +-- Blocks, waiting on the jobserver to supply a free token. +acquireJob :: TVar JobResources -> IO () +acquireJob jobs_tvar = do + (job_tmvar, _jobs0) <- tracedAtomically "acquire" $ + modifyJobResources jobs_tvar \ jobs -> do + job_tmvar <- newEmptyTMVar + return ((job_tmvar, jobs), addJob job_tmvar jobs) + atomically $ takeTMVar job_tmvar + +-- | Signal to the job server that one job has completed, +-- releasing its corresponding token. +releaseJob :: TVar JobResources -> IO () +releaseJob jobs_tvar = do + tracedAtomically "release" do + modifyJobResources jobs_tvar \ jobs -> do + massertPpr (tokensFree jobs < tokensOwned jobs) + (text "releaseJob: more free jobs than owned jobs!") + return ((), addFreeToken jobs) + + +-- | Release all tokens owned from the semaphore (to clean up +-- the jobserver at the end). +cleanupJobserver :: Jobserver -> IO () +cleanupJobserver (Jobserver { jSemaphore = sem + , jobs = jobs_tvar }) + = do + Jobs { tokensOwned = owned } <- readTVarIO jobs_tvar + let toks_to_release = owned - 1 + -- Subtract off the implicit token: whoever spawned the ghc process + -- in the first place is responsible for that token. + releaseSemaphore sem toks_to_release + +-- | Dispatch the available tokens acquired from the semaphore +-- to the pending jobs in the job server. +dispatchTokens :: JobResources -> STM JobResources +dispatchTokens jobs@( Jobs { tokensFree = toks_free, jobsWaiting = wait } ) + | toks_free > 0 + , next `ConsOL` rest <- wait + -- There's a pending job and a free token: + -- pass on the token to that job, and recur. + = do + putTMVar next () + let jobs' = jobs { tokensFree = toks_free - 1, jobsWaiting = rest } + dispatchTokens jobs' + | otherwise + = return jobs + +-- | Update the available resources used from a semaphore, dispatching +-- any newly acquired resources. +-- +-- Invariant: if the number of available resources decreases, there +-- must be no pending jobs. +-- +-- All modifications should go through this function to ensure the contents +-- of the 'TVar' remains in normal form. +modifyJobResources :: HasCallStack => TVar JobResources + -> (JobResources -> STM (a, JobResources)) + -> STM (a, Maybe JobResources) +modifyJobResources jobs_tvar action = do + old_jobs <- readTVar jobs_tvar + (a, jobs) <- action old_jobs + + -- Check the invariant: if the number of free tokens has decreased, + -- there must be no pending jobs. + massertPpr (null (jobsWaiting jobs) || tokensFree jobs >= tokensFree old_jobs) $ + vcat [ text "modiyJobResources: pending jobs but fewer free tokens" ] + dispatched_jobs <- dispatchTokens jobs + writeTVar jobs_tvar dispatched_jobs + return (a, Just dispatched_jobs) + + +tracedAtomically_ :: String -> STM (Maybe JobResources) -> IO () +tracedAtomically_ s act = tracedAtomically s (((),) <$> act) + +tracedAtomically :: String -> STM (a, Maybe JobResources) -> IO a +tracedAtomically origin act = do + (a, mjr) <- atomically act + forM_ mjr $ \ jr -> do + -- Use the "jsem:" prefix to identify where the write traces are + traceEventIO ("jsem:" ++ renderJobResources origin jr) + return a + +renderJobResources :: String -> JobResources -> String +renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON $ + JSObject [ ("name", JSString origin) + , ("owned", JSInt own) + , ("free", JSInt free) + , ("pending", JSInt (length pending) ) + ] + + +-- | Spawn a new thread that waits on the semaphore in order to acquire +-- an additional token. +acquireThread :: Jobserver -> IO JobserverAction +acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + let + wait_result_action :: Either MC.SomeException Bool -> IO () + wait_result_action wait_res = + tracedAtomically_ "acquire_thread" do + (r, jb) <- case wait_res of + Left (e :: MC.SomeException) -> do + return $ (Just e, Nothing) + Right success -> do + if success + then do + modifyJobResources jobs_tvar \ jobs -> + return (Nothing, addToken jobs) + else + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jb + wait_id <- forkWaitOnSemaphoreInterruptible sem wait_result_action + labelThread (waitingThreadId wait_id) "acquire_thread" + return $ Acquiring { activeWaitId = wait_id + , threadFinished = threadFinished_tmvar } + +-- | Spawn a thread to release ownership of one resource from the semaphore, +-- provided we have spare resources and no pending jobs. +releaseThread :: Jobserver -> IO JobserverAction +releaseThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + MC.mask_ do + -- Pre-release the resource so that another thread doesn't take control of it + -- just as we release the lock on the semaphore. + still_ok_to_release + <- tracedAtomically "pre_release" $ + modifyJobResources jobs_tvar \ jobs -> + if guardRelease jobs + -- TODO: should this also debounce? + then return (True , removeOwnedToken $ removeFreeToken jobs) + else return (False, jobs) + if not still_ok_to_release + then return Idle + else do + tid <- forkIO $ do + x <- MC.try $ releaseSemaphore sem 1 + tracedAtomically_ "post-release" $ do + (r, jobs) <- case x of + Left (e :: MC.SomeException) -> do + modifyJobResources jobs_tvar \ jobs -> + return (Just e, addToken jobs) + Right _ -> do + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jobs + labelThread tid "release_thread" + return Idle + +-- | When there are pending jobs but no free tokens, +-- spawn a thread to acquire a new token from the semaphore. +-- +-- See 'acquireThread'. +tryAcquire :: JobserverOptions + -> Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryAcquire opts js@( Jobserver { jobs = jobs_tvar }) + st@( JobserverState { jobserverAction = Idle } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardAcquire jobs + return do + action <- acquireThread js + -- Set a debounce after acquiring a token. + can_release_tvar <- registerDelay $ (releaseDebounce opts * 1000) + return $ st { jobserverAction = action + , canReleaseToken = can_release_tvar } +tryAcquire _ _ _ = retry + +-- | When there are free tokens and no pending jobs, +-- spawn a thread to release a token from the semamphore. +-- +-- See 'releaseThread'. +tryRelease :: Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryRelease sjs@( Jobserver { jobs = jobs_tvar } ) + st@( JobserverState + { jobserverAction = Idle + , canReleaseToken = can_release_tvar } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardRelease jobs + can_release <- readTVar can_release_tvar + guard can_release + return do + action <- releaseThread sjs + return $ st { jobserverAction = action } +tryRelease _ _ = retry + +-- | Wait for an active thread to finish. Once it finishes: +-- +-- - set the 'JobserverAction' to 'Idle', +-- - update the number of capabilities to reflect the number +-- of owned tokens from the semaphore. +tryNoticeIdle :: JobserverOptions + -> TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryNoticeIdle opts jobs_tvar jobserver_state + | Just threadFinished_tmvar <- activeThread_maybe $ jobserverAction jobserver_state + = sync_num_caps (canChangeNumCaps jobserver_state) threadFinished_tmvar + | otherwise + = retry -- no active thread: wait until jobserver isn't idle + where + sync_num_caps :: TVar Bool + -> TMVar (Maybe MC.SomeException) + -> STM (IO JobserverState) + sync_num_caps can_change_numcaps_tvar threadFinished_tmvar = do + mb_ex <- takeTMVar threadFinished_tmvar + for_ mb_ex MC.throwM + Jobs { tokensOwned } <- readTVar jobs_tvar + can_change_numcaps <- readTVar can_change_numcaps_tvar + guard can_change_numcaps + return do + x <- getNumCapabilities + can_change_numcaps_tvar_2 <- + if x == tokensOwned + then return can_change_numcaps_tvar + else do + setNumCapabilities tokensOwned + registerDelay $ (setNumCapsDebounce opts * 1000) + return $ + jobserver_state + { jobserverAction = Idle + , canChangeNumCaps = can_change_numcaps_tvar_2 } + +-- | Try to stop the current thread which is acquiring/releasing resources +-- if that operation is no longer relevant. +tryStopThread :: TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryStopThread jobs_tvar jsj = do + case jobserverAction jsj of + Acquiring { activeWaitId = wait_id } -> do + jobs <- readTVar jobs_tvar + guard $ null (jobsWaiting jobs) + return do + interruptWaitOnSemaphore wait_id + return $ jsj { jobserverAction = Idle } + _ -> retry + +-- | Main jobserver loop: acquire/release resources as +-- needed for the pending jobs and available semaphore tokens. +jobserverLoop :: JobserverOptions -> Jobserver -> IO () +jobserverLoop opts sjs@(Jobserver { jobs = jobs_tvar }) + = do + true_tvar <- newTVarIO True + let init_state :: JobserverState + init_state = + JobserverState + { jobserverAction = Idle + , canChangeNumCaps = true_tvar + , canReleaseToken = true_tvar } + loop init_state + where + loop s = do + action <- atomically $ asum $ (\x -> x s) <$> + [ tryRelease sjs + , tryAcquire opts sjs + , tryNoticeIdle opts jobs_tvar + , tryStopThread jobs_tvar + ] + s <- action + loop s + +-- | Create a new jobserver using the given semaphore handle. +makeJobserver :: SemaphoreName -> IO (AbstractSem, IO ()) +makeJobserver sem_name = do + semaphore <- openSemaphore sem_name + let + init_jobs = + Jobs { tokensOwned = 1 + , tokensFree = 1 + , jobsWaiting = NilOL + } + jobs_tvar <- newTVarIO init_jobs + let + opts = defaultJobserverOptions -- TODO: allow this to be configured + sjs = Jobserver { jSemaphore = semaphore + , jobs = jobs_tvar } + loop_finished_mvar <- newEmptyMVar + loop_tid <- forkIOWithUnmask \ unmask -> do + r <- try $ unmask $ jobserverLoop opts sjs + putMVar loop_finished_mvar $ + case r of + Left e + | Just ThreadKilled <- fromException e + -> Nothing + | otherwise + -> Just e + Right () -> Nothing + labelThread loop_tid "job_server" + let + acquireSem = acquireJob jobs_tvar + releaseSem = releaseJob jobs_tvar + cleanupSem = do + -- this is interruptible + cleanupJobserver sjs + killThread loop_tid + mb_ex <- takeMVar loop_finished_mvar + for_ mb_ex MC.throwM + + return (AbstractSem{..}, cleanupSem) + +-- | Implement an abstract semaphore using a semaphore 'Jobserver' +-- which queries the system semaphore of the given name for resources. +runJSemAbstractSem :: SemaphoreName -- ^ the system semaphore to use + -> (AbstractSem -> IO a) -- ^ the operation to run + -- which requires a semaphore + -> IO a +runJSemAbstractSem sem action = MC.mask \ unmask -> do + (abs, cleanup) <- makeJobserver sem + r <- try $ unmask $ action abs + case r of + Left (e1 :: MC.SomeException) -> do + (_ :: Either MC.SomeException ()) <- MC.try cleanup + MC.throwM e1 + Right x -> cleanup $> x + +{- +Note [Architecture of the Job Server] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In `-jsem` mode, the amount of parallelism that GHC can use is controlled by a +system semaphore. We take resources from the semaphore when we need them, and +give them back if we don't have enough to do. + +A naive implementation would just take and release the semaphore around performing +the action, but this leads to two issues: + +* When taking a token in the semaphore, we must call `setNumCapabilities` in order + to adjust how many capabilities are available for parallel garbage collection. + This causes unnecessary synchronisations. +* We want to implement a debounce, so that whilst there is pending work in the + current process we prefer to keep hold of resources from the semaphore. + This reduces overall memory usage, as there are fewer live GHC processes at once. + +Therefore, the obtention of semaphore resources is separated away from the +request for the resource in the driver. + +A token from the semaphore is requested using `acquireJob`. This creates a pending +job, which is a MVar that can be filled in to signal that the requested token is ready. + +When the job is finished, the token is released by calling `releaseJob`, which just +increases the number of `free` jobs. If there are more pending jobs when the free count +is increased, the token is immediately reused (see `modifyJobResources`). + +The `jobServerLoop` interacts with the system semaphore: when there are pending +jobs, `acquireThread` blocks, waiting for a token from the semaphore. Once a +token is obtained, it increases the owned count. + +When GHC has free tokens (tokens from the semaphore that it is not using), +no pending jobs, and the debounce has expired, then `releaseThread` will +release tokens back to the global semaphore. + +`tryStopThread` attempts to kill threads which are waiting to acquire a resource +when we no longer need it. For example, consider that we attempt to acquire two +tokens, but the first job finishes before we acquire the second token. +This second token is no longer needed, so we should cancel the wait +(as it would not be used to do any work, and not be returned until the debounce). +We only need to kill `acquireJob`, because `releaseJob` never blocks. + +Note [Eventlog Messages for jsem] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +It can be tricky to verify that the work is shared adequately across different +processes. To help debug this, we output the values of `JobResource` to the +eventlog whenever the global state changes. There are some scripts which can be used +to analyse this output and report statistics about core saturation in the +GitHub repo (https://github.com/mpickering/ghc-jsem-analyse). + +-} ===================================== compiler/GHC/Driver/Pipeline/LogQueue.hs ===================================== @@ -100,10 +100,10 @@ dequeueLogQueueQueue (LogQueueQueue n lqq) = case IM.minViewWithKey lqq of Just ((k, v), lqq') | k == n -> Just (v, LogQueueQueue (n + 1) lqq') _ -> Nothing -logThread :: Int -> Int -> Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit +logThread :: Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit -> TVar LogQueueQueue -- Queue for logs -> IO (IO ()) -logThread _ _ logger stopped lqq_var = do +logThread logger stopped lqq_var = do finished_var <- newEmptyMVar _ <- forkIO $ print_logs *> putMVar finished_var () return (takeMVar finished_var) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -43,6 +43,7 @@ module GHC.Driver.Session ( needSourceNotes, OnOff(..), DynFlags(..), + ParMakeCount(..), outputFile, objectSuf, ways, FlagSpec(..), HasDynFlags(..), ContainsDynFlags(..), @@ -461,9 +462,13 @@ data DynFlags = DynFlags { ruleCheck :: Maybe String, strictnessBefore :: [Int], -- ^ Additional demand analysis - parMakeCount :: Maybe Int, -- ^ The number of modules to compile in parallel - -- in --make mode, where Nothing ==> compile as - -- many in parallel as there are CPUs. + parMakeCount :: Maybe ParMakeCount, + -- ^ The number of modules to compile in parallel + -- in --make mode, ignored with a warning if jobServerAuth is specified. + -- If unspecified, compile with a single job. + + jsemHandle :: Maybe FilePath, + -- ^ A handle to a parallelism semaphore enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? ghcHeapSize :: Maybe Int, -- ^ The heap size to set. @@ -783,6 +788,12 @@ instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where class ContainsDynFlags t where extractDynFlags :: t -> DynFlags +-- | The type for the -jN argument, specifying that -j on its own represents +-- using the number of machine processors. +data ParMakeCount + = ParMakeThisMany Int + | ParMakeNumProcessors + ----------------------------------------------------------------------------- -- Accessors from 'DynFlags' @@ -1146,7 +1157,8 @@ defaultDynFlags mySettings = historySize = 20, strictnessBefore = [], - parMakeCount = Just 1, + parMakeCount = Nothing, + jsemHandle = Nothing, enableTimeStats = False, ghcHeapSize = Nothing, @@ -2066,14 +2078,16 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "j" (OptIntSuffix (\n -> case n of Just n - | n > 0 -> upd (\d -> d { parMakeCount = Just n }) + | n > 0 -> upd (\d -> d { parMakeCount = Just (ParMakeThisMany n) }) | otherwise -> addErr "Syntax: -j[n] where n > 0" - Nothing -> upd (\d -> d { parMakeCount = Nothing }))) + Nothing -> upd (\d -> d { parMakeCount = Just ParMakeNumProcessors }))) -- When the number of parallel builds -- is omitted, it is the same -- as specifying that the number of -- parallel builds is equal to the -- result of getNumProcessors + , make_ord_flag defGhcFlag "jsem" $ hasArg $ \f d -> d { jsemHandle = Just f } + , make_ord_flag defFlag "instantiated-with" (sepArg setUnitInstantiations) , make_ord_flag defFlag "this-component-id" (sepArg setUnitInstanceOf) @@ -4886,6 +4900,11 @@ makeDynFlagsConsistent dflags , Nothing <- outputFile dflags = pgmError "--output must be specified when using --merge-objs" + | Just _ <- jsemHandle dflags + , Just _ <- parMakeCount dflags + = loop dflags{parMakeCount = Nothing} + "`-j` argument is ignored when using `-jsem`" + | otherwise = (dflags, []) where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") loop updated_dflags warning ===================================== compiler/ghc.cabal.in ===================================== @@ -85,6 +85,7 @@ Library hpc == 0.6.*, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, + semaphore-compat, stm, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, @@ -436,6 +437,7 @@ Library GHC.Driver.GenerateCgIPEStub GHC.Driver.Hooks GHC.Driver.LlvmConfigCache + GHC.Driver.MakeSem GHC.Driver.Main GHC.Driver.Make GHC.Driver.MakeFile ===================================== docs/users_guide/using.rst ===================================== @@ -751,6 +751,58 @@ search path (see :ref:`search-path`). number of processors. Note that compilation of a module may not begin until its dependencies have been built. + +GHC Jobserver Protocol +~~~~~~~~~~~~~~~~~~~~~~ + +This protocol allows +a server to dynamically invoke many instances of a client process, +while restricting all of those instances to use no more than capabilities. +This is achieved by coordination over a system semaphore (either a POSIX +semaphore in the case of Linux and Darwin, or a Win32 semaphore +in the case of Windows platforms). + +There are two kinds of participants in the GHC Jobserver protocol: + +- The *jobserver* creates a system semaphore with a certain number of + available tokens. + + Each time the jobserver wants to spawn a new jobclient subprocess, it **must** + first acquire a single token from the semaphore, before spawning + the subprocess. This token **must** be released once the subprocess terminates. + + Once work is finished, the jobserver **must** destroy the semaphore it created. + +- A *jobclient* is a subprocess spawned by the jobserver or another jobclient. + + Each jobclient starts with one available token (its *implicit token*, + which was acquired by the parent which spawned it), and can request more + tokens through the Jobserver Protocol by waiting on the semaphore. + + Each time a jobclient wants to spawn a new jobclient subprocess, it **must** + pass on a single token to the child jobclient. This token can either be the + jobclient's implicit token, or another token which the jobclient acquired + from the semaphore. + + Each jobclient **must** release exactly as many tokens as it has acquired from + the semaphore (this does not include the implicit tokens). + + GHC itself acts as a jobclient which can be enabled by using the flag ``-jsem``. + +.. ghc-flag:: -jsem + :shortdesc: When compiling with :ghc-flag:`--make`, coordinate with + other processes through the semaphore ⟨sem⟩ to compile + modules in parallel. + :type: dynamic + :category: misc + Perform compilation in parallel when possible, coordinating with other + processes through the semaphore ⟨sem⟩. + Error if the semaphore doesn't exist. + + Use of ``-jsem`` will override use of :ghc-flag:``-j[⟨n⟩]``. + + + .. _multi-home-units: Multiple Home Units ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -39,7 +39,7 @@ ghcPackages = , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl - , parsec, pretty, process, rts, runGhc, stm, templateHaskell + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon @@ -55,7 +55,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, - parsec, pretty, primitive, process, rts, runGhc, stm, templateHaskell, + parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -110,6 +110,7 @@ process = lib "process" remoteIserv = util "remote-iserv" rts = top "rts" runGhc = util "runghc" +semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" terminfo = lib "terminfo" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -171,6 +171,7 @@ toolTargets = [ binary , templateHaskell , text , transformers + , semaphoreCompat , unlit -- # executable ] ++ if windowsHost then [ win32 ] else [ unix ] ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -95,6 +95,7 @@ stage0Packages = do , hpcBin , mtl , parsec + , semaphoreCompat , time , templateHaskell , text @@ -142,6 +143,7 @@ stage1Packages = do , integerGmp , pretty , rts + , semaphoreCompat , stm , unlit , xhtml ===================================== libraries/semaphore-compat ===================================== @@ -0,0 +1 @@ +Subproject commit 663ef75467995acf41c51d3e21d03347e85b844e ===================================== packages ===================================== @@ -65,5 +65,6 @@ libraries/Win32 - - https:/ libraries/xhtml - - https://github.com/haskell/xhtml.git libraries/exceptions - - https://github.com/ekmett/exceptions.git nofib nofib - - +libraries/semaphore-compat - - - libraries/stm - - ssh://git at github.com/haskell/stm.git . - ghc.git - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/223cefde1443282a12232337247fbf0d6a520a2a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/223cefde1443282a12232337247fbf0d6a520a2a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 13:02:20 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 16 Mar 2023 09:02:20 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/exception-context-9.6 Message-ID: <6413135cc802c_37e76b3725e5f44692a@gitlab.mail> Ben Gamari pushed new branch wip/exception-context-9.6 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/exception-context-9.6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 13:42:39 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 16 Mar 2023 09:42:39 -0400 Subject: [Git][ghc/ghc][wip/interface-loading-errs] fixes Message-ID: <64131ccfd69af_37e76b37c1a4d04754e4@gitlab.mail> Matthew Pickering pushed to branch wip/interface-loading-errs at Glasgow Haskell Compiler / GHC Commits: d789fd0d by Matthew Pickering at 2023-03-16T13:42:26+00:00 fixes - - - - - 30 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - testsuite/tests/cabal/cabal05/cabal05.stderr - testsuite/tests/cabal/ghcpkg04.stderr - testsuite/tests/driver/driver063.stderr - testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stderr - testsuite/tests/driver/dynamicToo/dynamicToo001boot/dynamicToo001boot.stderr - testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr - testsuite/tests/ghc-api/target-contents/TargetContents.stderr - testsuite/tests/ghc-e/should_fail/T9905fail1.stderr - testsuite/tests/ghc-e/should_run/T2636.stderr - testsuite/tests/ghci.debugger/scripts/dynbrk001.stderr - testsuite/tests/ghci/scripts/T20455.stderr - testsuite/tests/ghci/scripts/T5836.stderr - testsuite/tests/ghci/scripts/T5979.stderr - testsuite/tests/ghci/should_fail/T15055.stderr - testsuite/tests/module/mod1.stderr - testsuite/tests/module/mod2.stderr - testsuite/tests/package/T4806.stderr - testsuite/tests/package/T4806a.stderr - testsuite/tests/package/package01e.stderr - testsuite/tests/package/package06e.stderr - testsuite/tests/package/package07e.stderr - testsuite/tests/package/package08e.stderr - testsuite/tests/package/package09e.stderr - testsuite/tests/perf/compiler/parsing001.stderr - testsuite/tests/plugins/T11244.stderr - testsuite/tests/plugins/plugins03.stderr - testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr - testsuite/tests/th/T10279.stderr - testsuite/tests/typecheck/should_fail/tcfail082.stderr Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -2443,7 +2443,7 @@ prettyCantFindWhat AmbiguousInterface= (text "Ambiguous interface for", colon) cantFindError :: Bool -> CantFindInstalled -> SDoc cantFindError verbose (CantFindInstalled mod_name what cfir) = let (ppr_what, punct) = prettyCantFindWhat what in - hang (ppr_what <+> quotes (ppr mod_name) <> punct) 4 $ + (ppr_what <+> quotes (ppr mod_name) <> punct) $$ case cfir of NoUnitIdMatching pkg cands -> @@ -2461,7 +2461,7 @@ cantFindError verbose (CantFindInstalled mod_name what cfir) = [] -> empty in hsep [ text "no unit id matching" <+> quotes (ppr pkg) - , text "was found" $$ looks_like_srcpkgid ] + , text "was found"] $$ looks_like_srcpkgid MissingPackageFiles pkg files -> text "There are files missing in the " <> quotes (ppr pkg) <> text " package," $$ ===================================== testsuite/tests/cabal/cabal05/cabal05.stderr ===================================== @@ -1,5 +1,5 @@ -T.hs:3:1: error: +T.hs:3:1: error: [GHC-00022] Ambiguous module name ‘Conflict’: - it is bound as p-0.1.0.0:P2 by a reexport in package q-0.1.0.0 - it is bound as P by a reexport in package r-0.1.0.0 + it is bound as p-0.1.0.0:P2 by a reexport in package q-0.1.0.0 + it is bound as P by a reexport in package r-0.1.0.0 ===================================== testsuite/tests/cabal/ghcpkg04.stderr ===================================== @@ -1,4 +1,4 @@ -ghcpkg04.hs:1:1: error: +ghcpkg04.hs:1:1: error: [GHC-00022] Ambiguous module name ‘A’: - it was found in multiple packages: newtestpkg-2.0 testpkg-1.2.3.4 + it was found in multiple packages: newtestpkg-2.0 testpkg-1.2.3.4 ===================================== testsuite/tests/driver/driver063.stderr ===================================== @@ -1,4 +1,4 @@ -D063.hs:2:1: error: - Could not find module ‘A063’ +D063.hs:2:1: error: [GHC-00024] + Could not find module ‘A063’. It is not a module in the current program, or in any known package. ===================================== testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stderr ===================================== @@ -1,5 +1,5 @@ -C.hs:5:1: error: +C.hs:5:1: error: [GHC-00005] Dynamic hash doesn't match for ‘B’ Normal interface file from ./B.hi Dynamic interface file from ./B.dyn_hi ===================================== testsuite/tests/driver/dynamicToo/dynamicToo001boot/dynamicToo001boot.stderr ===================================== @@ -1,5 +1,5 @@ -C.hs:5:1: error: +C.hs:5:1: error: [GHC-00005] Dynamic hash doesn't match for ‘B’ Normal interface file from ./B.hi-boot Dynamic interface file from ./B.dyn_hi-boot ===================================== testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr ===================================== @@ -1,5 +1,5 @@ -module-visibility-import/MV.hs:5:1: error: - Could not load module ‘MV2’ +module-visibility-import/MV.hs:5:1: error: [GHC-00017] + Could not load module ‘MV2’. it is a hidden module in the package ‘mv’ Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/ghc-api/target-contents/TargetContents.stderr ===================================== @@ -16,8 +16,8 @@ B.hs:3:5: error: [GHC-88464] Variable not in scope: z B.hs:3:5: error: [GHC-88464] Variable not in scope: z == Dep_Error_MM_A -A.hs:3:1: error: - Could not find module ‘B’ +A.hs:3:1: error: [GHC-00017] + Could not find module ‘B’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. == Dep_DM_AB == Dep_Error_DM_AB @@ -25,8 +25,8 @@ A.hs:3:1: error: B.hs:3:5: error: [GHC-88464] Variable not in scope: z == Dep_Error_DM_A -A.hs:3:1: error: - Could not find module ‘B’ +A.hs:3:1: error: [GHC-00017] + Could not find module ‘B’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. == Dep_MD_AB == Dep_Error_MD_AB ===================================== testsuite/tests/ghc-e/should_fail/T9905fail1.stderr ===================================== @@ -1,5 +1,5 @@ -: error: - Could not find module ‘This.Module.Does.Not.Exist’ +: error: [GHC-00024] + Could not find module ‘This.Module.Does.Not.Exist’. It is not a module in the current program, or in any known package. 1 ===================================== testsuite/tests/ghc-e/should_run/T2636.stderr ===================================== @@ -1,4 +1,4 @@ -T2636.hs:1:1: error: - Could not find module ‘MissingModule’ +T2636.hs:1:1: error: [GHC-00017] + Could not find module ‘MissingModule’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/ghci.debugger/scripts/dynbrk001.stderr ===================================== @@ -1,4 +1,4 @@ -: - Could not find module ‘NonModule’ +: error: [GHC-00024] + Could not find module ‘NonModule’. It is not a module in the current program, or in any known package. ===================================== testsuite/tests/ghci/scripts/T20455.stderr ===================================== @@ -6,6 +6,6 @@ ‘Ghci1.l’ (imported from Ghci1), ‘l’ (line 2), ‘all’ (imported from Prelude) -: error: - Could not find module ‘Ghci1’ +: error: [GHC-00024] + Could not find module ‘Ghci1’. It is not a module in the current program, or in any known package. ===================================== testsuite/tests/ghci/scripts/T5836.stderr ===================================== @@ -1,4 +1,4 @@ -: - Could not find module ‘Does.Not.Exist’ +: error: [GHC-00024] + Could not find module ‘Does.Not.Exist’. It is not a module in the current program, or in any known package. ===================================== testsuite/tests/ghci/scripts/T5979.stderr ===================================== @@ -1,7 +1,7 @@ -: error: - Could not find module ‘Control.Monad.Trans.State’ +: error: [GHC-00020] + Could not find module ‘Control.Monad.Trans.State’. Perhaps you meant - Control.Monad.Trans.State (from transformers-0.5.6.2) - Control.Monad.Trans.Cont (from transformers-0.5.6.2) - Control.Monad.Trans.Class (from transformers-0.5.6.2) + Control.Monad.Trans.State (from transformers-0.6.1.0) + Control.Monad.Trans.Cont (from transformers-0.6.1.0) + Control.Monad.Trans.Class (from transformers-0.6.1.0) ===================================== testsuite/tests/ghci/should_fail/T15055.stderr ===================================== @@ -1,6 +1,6 @@ -: error: - Could not load module ‘GHC’ - It is a member of the hidden package ‘ghc-8.5’. +: error: [GHC-00017] + Could not load module ‘GHC’. + It is a member of the hidden package ‘ghc-9.7’. You can run ‘:set -package ghc’ to expose it. (Note: this unloads all the modules in the current scope.) ===================================== testsuite/tests/module/mod1.stderr ===================================== @@ -1,4 +1,4 @@ -mod1.hs:3:1: error: - Could not find module ‘N’ +mod1.hs:3:1: error: [GHC-00017] + Could not find module ‘N’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/module/mod2.stderr ===================================== @@ -1,4 +1,4 @@ -mod2.hs:3:1: error: - Could not find module ‘N’ +mod2.hs:3:1: error: [GHC-00017] + Could not find module ‘N’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/package/T4806.stderr ===================================== @@ -1,6 +1,6 @@ -T4806.hs:1:1: error: - Could not load module ‘Data.Map’ - It is a member of the package ‘containers-0.6.0.1’ +T4806.hs:1:1: error: [GHC-00017] + Could not load module ‘Data.Map’. + It is a member of the package ‘containers-0.6.7’ which is ignored due to an -ignore-package flag Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/package/T4806a.stderr ===================================== @@ -1,7 +1,7 @@ -T4806a.hs:1:1: error: - Could not load module ‘Data.Map’ - It is a member of the package ‘containers-0.6.6’ +T4806a.hs:1:1: error: [GHC-00017] + Could not load module ‘Data.Map’. + It is a member of the package ‘containers-0.6.7’ which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies: - deepseq-1.4.8.0 template-haskell-2.20.0.0 + deepseq-1.4.8.1 template-haskell-2.20.0.0 Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/package/package01e.stderr ===================================== @@ -1,14 +1,14 @@ -package01e.hs:2:1: error: - Could not load module ‘Data.Map’ - It is a member of the hidden package ‘containers-0.6.0.1’. +package01e.hs:2:1: error: [GHC-00017] + Could not load module ‘Data.Map’. + It is a member of the hidden package ‘containers-0.6.7’. You can run ‘:set -package containers’ to expose it. (Note: this unloads all the modules in the current scope.) Use -v (or `:set -v` in ghci) to see a list of the files searched for. -package01e.hs:3:1: error: - Could not load module ‘Data.IntMap’ - It is a member of the hidden package ‘containers-0.6.0.1’. +package01e.hs:3:1: error: [GHC-00017] + Could not load module ‘Data.IntMap’. + It is a member of the hidden package ‘containers-0.6.7’. You can run ‘:set -package containers’ to expose it. (Note: this unloads all the modules in the current scope.) Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/package/package06e.stderr ===================================== @@ -1,14 +1,14 @@ -package06e.hs:2:1: error: - Could not load module ‘GHC.Hs.Type’ - It is a member of the hidden package ‘ghc-8.7’. +package06e.hs:2:1: error: [GHC-00017] + Could not load module ‘GHC.Hs.Type’. + It is a member of the hidden package ‘ghc-9.7’. You can run ‘:set -package ghc’ to expose it. (Note: this unloads all the modules in the current scope.) Use -v (or `:set -v` in ghci) to see a list of the files searched for. -package06e.hs:3:1: error: - Could not load module ‘GHC.Types.Unique.FM’ - It is a member of the hidden package ‘ghc-8.7’. +package06e.hs:3:1: error: [GHC-00017] + Could not load module ‘GHC.Types.Unique.FM’. + It is a member of the hidden package ‘ghc-9.7’. You can run ‘:set -package ghc’ to expose it. (Note: this unloads all the modules in the current scope.) Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/package/package07e.stderr ===================================== @@ -1,29 +1,29 @@ -package07e.hs:2:1: error: - Could not find module ‘GHC.Hs.MyTypes’ +package07e.hs:2:1: error: [GHC-00020] + Could not find module ‘GHC.Hs.MyTypes’. Perhaps you meant - GHC.Hs.Type (needs flag -package-id ghc-9.3) - GHC.Tc.Types (needs flag -package-id ghc-9.3) - GHC.Hs.Syn.Type (needs flag -package-id ghc-9.3) + GHC.Hs.Type (needs flag -package-id ghc-9.7) + GHC.Tc.Types (needs flag -package-id ghc-9.7) + GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7) Use -v (or `:set -v` in ghci) to see a list of the files searched for. -package07e.hs:3:1: error: - Could not load module ‘GHC.Hs.Type’ - It is a member of the hidden package ‘ghc-9.3’. +package07e.hs:3:1: error: [GHC-00017] + Could not load module ‘GHC.Hs.Type’. + It is a member of the hidden package ‘ghc-9.7’. You can run ‘:set -package ghc’ to expose it. (Note: this unloads all the modules in the current scope.) Use -v (or `:set -v` in ghci) to see a list of the files searched for. -package07e.hs:4:1: error: - Could not load module ‘GHC.Hs.Utils’ - It is a member of the hidden package ‘ghc-9.3’. +package07e.hs:4:1: error: [GHC-00017] + Could not load module ‘GHC.Hs.Utils’. + It is a member of the hidden package ‘ghc-9.7’. You can run ‘:set -package ghc’ to expose it. (Note: this unloads all the modules in the current scope.) Use -v (or `:set -v` in ghci) to see a list of the files searched for. -package07e.hs:5:1: error: - Could not load module ‘GHC.Types.Unique.FM’ - It is a member of the hidden package ‘ghc-9.3’. +package07e.hs:5:1: error: [GHC-00017] + Could not load module ‘GHC.Types.Unique.FM’. + It is a member of the hidden package ‘ghc-9.7’. You can run ‘:set -package ghc’ to expose it. (Note: this unloads all the modules in the current scope.) Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/package/package08e.stderr ===================================== @@ -1,29 +1,29 @@ -package08e.hs:2:1: error: - Could not find module ‘GHC.Hs.MyTypes’ +package08e.hs:2:1: error: [GHC-00020] + Could not find module ‘GHC.Hs.MyTypes’. Perhaps you meant - GHC.Hs.Type (needs flag -package-id ghc-9.3) - GHC.Tc.Types (needs flag -package-id ghc-9.3) - GHC.Hs.Syn.Type (needs flag -package-id ghc-9.3) + GHC.Hs.Type (needs flag -package-id ghc-9.7) + GHC.Tc.Types (needs flag -package-id ghc-9.7) + GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7) Use -v (or `:set -v` in ghci) to see a list of the files searched for. -package08e.hs:3:1: error: - Could not load module ‘GHC.Hs.Type’ - It is a member of the hidden package ‘ghc-9.3’. +package08e.hs:3:1: error: [GHC-00017] + Could not load module ‘GHC.Hs.Type’. + It is a member of the hidden package ‘ghc-9.7’. You can run ‘:set -package ghc’ to expose it. (Note: this unloads all the modules in the current scope.) Use -v (or `:set -v` in ghci) to see a list of the files searched for. -package08e.hs:4:1: error: - Could not load module ‘GHC.Hs.Utils’ - It is a member of the hidden package ‘ghc-9.3’. +package08e.hs:4:1: error: [GHC-00017] + Could not load module ‘GHC.Hs.Utils’. + It is a member of the hidden package ‘ghc-9.7’. You can run ‘:set -package ghc’ to expose it. (Note: this unloads all the modules in the current scope.) Use -v (or `:set -v` in ghci) to see a list of the files searched for. -package08e.hs:5:1: error: - Could not load module ‘GHC.Types.Unique.FM’ - It is a member of the hidden package ‘ghc-9.3’. +package08e.hs:5:1: error: [GHC-00017] + Could not load module ‘GHC.Types.Unique.FM’. + It is a member of the hidden package ‘ghc-9.7’. You can run ‘:set -package ghc’ to expose it. (Note: this unloads all the modules in the current scope.) Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/package/package09e.stderr ===================================== @@ -1,5 +1,5 @@ -package09e.hs:2:1: error: +package09e.hs:2:1: error: [GHC-00022] Ambiguous module name ‘M’: - it is bound as Data.Set by a package flag - it is bound as Data.Map by a package flag + it is bound as Data.Set by a package flag + it is bound as Data.Map by a package flag ===================================== testsuite/tests/perf/compiler/parsing001.stderr ===================================== @@ -1,4 +1,4 @@ -parsing001.hs:3:1: error: - Could not find module ‘Wibble’ +parsing001.hs:3:1: error: [GHC-00017] + Could not find module ‘Wibble’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/plugins/T11244.stderr ===================================== @@ -1,4 +1,4 @@ -: Could not load module ‘RuleDefiningPlugin’ +: Could not load module ‘RuleDefiningPlugin’. It is a member of the hidden package ‘rule-defining-plugin-0.1’. You can run ‘:set -package rule-defining-plugin’ to expose it. (Note: this unloads all the modules in the current scope.) ===================================== testsuite/tests/plugins/plugins03.stderr ===================================== @@ -1,2 +1,2 @@ -: Could not find module ‘Simple.NonExistentPlugin’ +: Could not find module ‘Simple.NonExistentPlugin’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr ===================================== @@ -2,6 +2,6 @@ SafeLang07.hs:2:14: warning: -XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving -SafeLang07.hs:15:1: error: - Could not find module ‘SafeLang07_A’ +SafeLang07.hs:15:1: error: [GHC-00017] + Could not find module ‘SafeLang07_A’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/th/T10279.stderr ===================================== @@ -1,6 +1,6 @@ -T10279.hs:10:9: error: [GHC-52243] - • Failed to load interface for ‘A’ +T10279.hs:10:9: error: [GHC-00023] + • Failed to load interface for ‘A’: no unit id matching ‘rts-1.0.2’ was found (This unit ID looks like the source package ID; the real unit ID is ‘rts’) ===================================== testsuite/tests/typecheck/should_fail/tcfail082.stderr ===================================== @@ -1,12 +1,12 @@ -tcfail082.hs:2:1: error: - Could not find module ‘Data82’ +tcfail082.hs:2:1: error: [GHC-00017] + Could not find module ‘Data82’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. -tcfail082.hs:3:1: error: - Could not find module ‘Inst82_1’ +tcfail082.hs:3:1: error: [GHC-00017] + Could not find module ‘Inst82_1’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. -tcfail082.hs:4:1: error: - Could not find module ‘Inst82_2’ +tcfail082.hs:4:1: error: [GHC-00017] + Could not find module ‘Inst82_2’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d789fd0d265513ec930c72645d1e26e99206b867 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d789fd0d265513ec930c72645d1e26e99206b867 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 15:38:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 16 Mar 2023 11:38:14 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 10 commits: DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) Message-ID: <641337e6af3b5_37e76b39f1ac8c4962e3@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - 36389b5a by Ben Gamari at 2023-03-16T11:38:03-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - c69091a1 by Ben Gamari at 2023-03-16T11:38:04-04:00 testsuite: Add test for atomicSwapIORef# - - - - - 20 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/StgToJS/Prim.hs - libraries/Win32 - libraries/base/GHC/IORef.hs - + libraries/base/tests/AtomicSwapIORef.hs - libraries/base/tests/all.T - libraries/ghc-bignum/ghc-bignum.cabal - rts/PrimOps.cmm - rts/include/Cmm.h - rts/js/rts.js - + testsuite/tests/javascript/T23101.hs - + testsuite/tests/javascript/T23101.stdout - + testsuite/tests/javascript/all.T - + testsuite/tests/stranal/should_compile/T22997.hs - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2464,6 +2464,13 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp + MutVar# s v -> v -> State# s -> (# State# s, a #) + {Atomically exchange the value of a 'MutVar#'.} + with + out_of_line = True + has_side_effects = True + -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1916,10 +1916,11 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- Check for an OPAQUE function: see Note [OPAQUE pragma] -- In that case, trim off all boxity info from argument demands + -- and demand info on lambda binders -- See Note [The OPAQUE pragma and avoiding the reboxing of arguments] | isOpaquePragma (idInlinePragma fn) , let trimmed_rhs_dmds = map trimBoxity rhs_dmds - = (trimmed_rhs_dmds, add_demands trimmed_rhs_dmds rhs) + = (trimmed_rhs_dmds, set_lam_dmds trimmed_rhs_dmds rhs) -- Check that we have enough visible binders to match the -- threshold arity; if not, we won't do worker/wrapper @@ -1939,8 +1940,8 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- vcat [text "function:" <+> ppr fn -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ - (arg_dmds', add_demands arg_dmds' rhs) - -- add_demands: we must attach the final boxities to the lambda-binders + (arg_dmds', set_lam_dmds arg_dmds' rhs) + -- set_lam_dmds: we must attach the final boxities to the lambda-binders -- of the function, both because that's kosher, and because CPR analysis -- uses the info on the binders directly. where @@ -2032,17 +2033,18 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs | positiveTopBudget bg_inner' = (bg_inner', dmd') | otherwise = (bg_inner, trimBoxity dmd) - add_demands :: [Demand] -> CoreExpr -> CoreExpr + set_lam_dmds :: [Demand] -> CoreExpr -> CoreExpr -- Attach the demands to the outer lambdas of this expression - add_demands [] e = e - add_demands (dmd:dmds) (Lam v e) - | isTyVar v = Lam v (add_demands (dmd:dmds) e) - | otherwise = Lam (v `setIdDemandInfo` dmd) (add_demands dmds e) - add_demands dmds (Cast e co) = Cast (add_demands dmds e) co + set_lam_dmds (dmd:dmds) (Lam v e) + | isTyVar v = Lam v (set_lam_dmds (dmd:dmds) e) + | otherwise = Lam (v `setIdDemandInfo` dmd) (set_lam_dmds dmds e) + set_lam_dmds dmds (Cast e co) = Cast (set_lam_dmds dmds e) co -- This case happens for an OPAQUE function, which may look like -- f = (\x y. blah) |> co -- We give it strictness but no boxity (#22502) - add_demands dmds e = pprPanic "add_demands" (ppr dmds $$ ppr e) + set_lam_dmds _ e = e + -- In the OPAQUE case, the list of demands at this point might be + -- non-empty, e.g., when looking at a PAP. Hence don't panic (#22997). finaliseLetBoxity :: AnalEnv ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -553,7 +553,7 @@ countArgs _ = 0 countValArgs :: SimplCont -> Int -- Count value arguments only -countValArgs (ApplyToTy { sc_cont = cont }) = 1 + countValArgs cont +countValArgs (ApplyToTy { sc_cont = cont }) = countValArgs cont countValArgs (ApplyToVal { sc_cont = cont }) = 1 + countValArgs cont countValArgs (CastIt _ cont) = countValArgs cont countValArgs _ = 0 @@ -1859,11 +1859,12 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr -> SimplM (ArityType, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpandRhs env bind_cxt bndr rhs - | do_eta_expand -- If the current manifest arity isn't enough - -- (never true for join points) - , seEtaExpand env -- and eta-expansion is on - , wantEtaExpansion rhs - = -- Do eta-expansion. + | seEtaExpand env -- If Eta-expansion is on + , wantEtaExpansion rhs -- and we'd like to eta-expand e + , do_eta_expand -- and e's manifest arity is lower than + -- what it could be + -- (never true for join points) + = -- Do eta-expansion. assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $ -- assert: this never happens for join points; see GHC.Core.Opt.Arity -- Note [Do not eta-expand join points] ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -639,7 +639,7 @@ jsResultWrapper result_ty | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey = do -- result_id <- newSysLocalDs boolTy ccall_uniq <- newUnique - let forceBool e = mkJsCall ccall_uniq (fsLit "$r = !(!$1)") [e] boolTy + let forceBool e = mkJsCall ccall_uniq (fsLit "((x) => { return !(!x); })") [e] boolTy return (Just intPrimTy, \e -> forceBool e) ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1559,6 +1559,7 @@ emitPrimOp cfg primop = ResizeMutableByteArrayOp_Char -> alwaysExternal ShrinkSmallMutableArrayOp_Char -> alwaysExternal NewMutVarOp -> alwaysExternal + AtomicSwapMutVarOp -> alwaysExternal AtomicModifyMutVar2Op -> alwaysExternal AtomicModifyMutVar_Op -> alwaysExternal CasMutVarOp -> alwaysExternal ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -115,8 +115,8 @@ genCommonCppDefs profiling = mconcat -- GHCJS.Prim.JSVal , if profiling - then "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)\n" - else "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x))\n" + then "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM))\n" + else "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x)))\n" , "#define JSVAL_VAL(x) ((x).d1)\n" -- GHCJS.Prim.JSException ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -859,6 +859,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[status,r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) ===================================== libraries/Win32 ===================================== @@ -1 +1 @@ -Subproject commit 931497f7052f63cb5cfd4494a94e572c5c570642 +Subproject commit efab7f1146da9741dc54fb35476d4aaabeff8d6d ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -28,6 +28,7 @@ module GHC.IORef ( import GHC.Base import GHC.STRef import GHC.IO +import GHC.Prim (atomicSwapMutVar#) -- --------------------------------------------------------------------------- -- IORefs @@ -127,10 +128,9 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a --- Bad implementation! This will be a primop shortly. atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicModifyMutVar2# ref (\_old -> Box new) s of - (# s', old, Box _new #) -> (# s', old #) + case atomicSwapMutVar# ref new s of + (# s', old #) -> (# s', old #) data Box a = Box a ===================================== libraries/base/tests/AtomicSwapIORef.hs ===================================== @@ -0,0 +1,7 @@ +import Data.IORef + +main :: IO () +main = do + r <- newIORef 42 :: IO Int + atomicSwapIORef r 43 + readIORef r >>= print ===================================== libraries/base/tests/all.T ===================================== @@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('AtomicSwapIORef', normal, compile_and_run, ['']) ===================================== libraries/ghc-bignum/ghc-bignum.cabal ===================================== @@ -89,8 +89,6 @@ library -- "ghc-bignum" and not "ghc-bignum-1.0". ghc-options: -this-unit-id ghc-bignum - include-dirs: include - if flag(gmp) cpp-options: -DBIGNUM_GMP other-modules: ===================================== rts/PrimOps.cmm ===================================== @@ -689,6 +689,14 @@ stg_newMutVarzh ( gcptr init ) return (mv); } +stg_swapMutVarzh ( gcptr mv, gcptr old ) + /* MutVar# s a -> a -> State# s -> (# State#, a #) */ +{ + W_ new; + (new) = prim %xchgW(mv+OFFSET_StgMutVar_var, old); + return (new); +} + // RRN: To support the "ticketed" approach, we return the NEW rather // than old value if the CAS is successful. This is received in an // opaque form in the Haskell code, preventing the compiler from ===================================== rts/include/Cmm.h ===================================== @@ -193,8 +193,10 @@ #if SIZEOF_W == 4 #define cmpxchgW cmpxchg32 +#define xchgW xchg32 #elif SIZEOF_W == 8 #define cmpxchgW cmpxchg64 +#define xchgW xchg64 #endif /* ----------------------------------------------------------------------------- ===================================== rts/js/rts.js ===================================== @@ -365,14 +365,7 @@ function h$printReg(r) { } else if(r.f.t === h$ct_blackhole && r.x) { return ("blackhole: -> " + h$printReg({ f: r.x.x1, d: r.d1.x2 }) + ")"); } else { - var iv = ""; - if(r.f.n === "integer-gmp:GHC.Integer.Type.Jp#" || - r.f.n === "integer-gmp:GHC.Integer.Type.Jn#") { - iv = ' [' + r.d1.join(',') + '](' + h$ghcjsbn_showBase(r.d1, 10) + ')' - } else if(r.f.n === "integer-gmp:GHC.Integer.Type.S#") { - iv = ' (S: ' + r.d1 + ')'; - } - return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")" + iv); + return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")"); } } else if(typeof r === 'object') { var res = h$collectProps(r); @@ -536,14 +529,7 @@ function h$dumpStackTop(stack, start, sp) { if(s.f.t === h$ct_blackhole && s.d1 && s.d1.x1 && s.d1.x1.n) { h$log("stack[" + i + "] = blackhole -> " + s.d1.x1.n); } else { - var iv = ""; - if(s.f.n === "integer-gmp:GHC.Integer.Type.Jp#" || - s.f.n === "integer-gmp:GHC.Integer.Type.Jn#") { - iv = ' [' + s.d1.join(',') + '](' + h$ghcjsbn_showBase(s.d1, 10) + ')' - } else if(s.f.n === "integer-gmp:GHC.Integer.Type.S#") { - iv = ' (S: ' + s.d1 + ')'; - } - h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")" + iv); + h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")"); } } } else if(h$isInstanceOf(s,h$MVar)) { ===================================== testsuite/tests/javascript/T23101.hs ===================================== @@ -0,0 +1,22 @@ + +foreign import javascript "(($1) => { return $1; })" + bool_id :: Bool -> Bool + +foreign import javascript "(($1) => { return !$1; })" + bool_not :: Bool -> Bool + +foreign import javascript "(($1) => { console.log($1); })" + bool_log :: Bool -> IO () + +main :: IO () +main = do + bool_log True + bool_log False + bool_log (bool_id True) + bool_log (bool_id False) + bool_log (bool_not True) + bool_log (bool_not False) + print (bool_id True) + print (bool_id False) + print (bool_not True) + print (bool_not False) ===================================== testsuite/tests/javascript/T23101.stdout ===================================== @@ -0,0 +1,10 @@ +true +false +true +false +false +true +True +False +False +True ===================================== testsuite/tests/javascript/all.T ===================================== @@ -0,0 +1,4 @@ +# These are JavaScript-specific tests +setTestOpts(when(not(js_arch()),skip)) + +test('T23101', normal, compile_and_run, ['']) ===================================== testsuite/tests/stranal/should_compile/T22997.hs ===================================== @@ -0,0 +1,9 @@ +module T22997 where + +{-# OPAQUE trivial #-} +trivial :: Int -> Int +trivial = succ + +{-# OPAQUE pap #-} +pap :: Integer -> Integer +pap = (42 +) ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -88,3 +88,5 @@ test('EtaExpansion', normal, compile, ['']) test('T22039', normal, compile, ['']) # T22388: Should see $winteresting but not $wboring test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl']) +# T22997: Just a panic that should not happen +test('T22997', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d8c42f9531e51ab7a04236bf550bcc763e28b05...c69091a1d39351bb5695bf1ff9e0151dda7b6078 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d8c42f9531e51ab7a04236bf550bcc763e28b05...c69091a1d39351bb5695bf1ff9e0151dda7b6078 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 16:18:09 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 16 Mar 2023 12:18:09 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Fix BCO creation setting caps when -j > -N Message-ID: <6413414156aea_37e76b3ac527d85086d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 4 changed files: - compiler/GHC/Driver/Config.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Interpreter.hs - docs/users_guide/9.8.1-notes.rst Changes: ===================================== compiler/GHC/Driver/Config.hs ===================================== @@ -2,7 +2,6 @@ module GHC.Driver.Config ( initOptCoercionOpts , initSimpleOpts - , initBCOOpts , initEvalOpts ) where @@ -12,12 +11,8 @@ import GHC.Prelude import GHC.Driver.Session import GHC.Core.SimpleOpt import GHC.Core.Coercion.Opt -import GHC.Runtime.Interpreter (BCOOpts(..)) import GHCi.Message (EvalOpts(..)) -import GHC.Conc (getNumProcessors) -import Control.Monad.IO.Class - -- | Initialise coercion optimiser configuration from DynFlags initOptCoercionOpts :: DynFlags -> OptCoercionOpts initOptCoercionOpts dflags = OptCoercionOpts @@ -32,16 +27,6 @@ initSimpleOpts dflags = SimpleOpts , so_eta_red = gopt Opt_DoEtaReduction dflags } --- | Extract BCO options from DynFlags -initBCOOpts :: DynFlags -> IO BCOOpts -initBCOOpts dflags = do - -- Serializing ResolvedBCO is expensive, so if we're in parallel mode - -- (-j) parallelise the serialization. - n_jobs <- case parMakeCount dflags of - Nothing -> liftIO getNumProcessors - Just n -> return n - return $ BCOOpts n_jobs - -- | Extract GHCi options from DynFlags and step initEvalOpts :: DynFlags -> Bool -> EvalOpts initEvalOpts dflags step = ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -43,7 +43,6 @@ import GHC.Driver.Phases import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Ppr -import GHC.Driver.Config import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Finder @@ -598,8 +597,7 @@ loadExpr interp hsc_env span root_ul_bco = do nobreakarray = error "no break array" bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)] resolved <- linkBCO interp le bco_ix nobreakarray root_ul_bco - bco_opts <- initBCOOpts (hsc_dflags hsc_env) - [root_hvref] <- createBCOs interp bco_opts [resolved] + [root_hvref] <- createBCOs interp [resolved] fhv <- mkFinalizedHValue interp root_hvref return (pls, fhv) where @@ -946,8 +944,7 @@ loadDecls interp hsc_env span cbc at CompiledByteCode{..} = do , addr_env = plusNameEnv (addr_env le) bc_strs } -- Link the necessary packages and linkables - bco_opts <- initBCOOpts (hsc_dflags hsc_env) - new_bindings <- linkSomeBCOs bco_opts interp le2 [cbc] + new_bindings <- linkSomeBCOs interp le2 [cbc] nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings let ce2 = extendClosureEnv (closure_env le2) nms_fhvs !pls2 = pls { linker_env = le2 { closure_env = ce2 } } @@ -995,7 +992,6 @@ loadModuleLinkables interp hsc_env pls linkables let (objs, bcos) = partition isObjectLinkable (concatMap partitionLinkable linkables) - bco_opts <- initBCOOpts (hsc_dflags hsc_env) -- Load objects first; they can't depend on BCOs (pls1, ok_flag) <- loadObjects interp hsc_env pls objs @@ -1003,7 +999,7 @@ loadModuleLinkables interp hsc_env pls linkables if failed ok_flag then return (pls1, Failed) else do - pls2 <- dynLinkBCOs bco_opts interp pls1 bcos + pls2 <- dynLinkBCOs interp pls1 bcos return (pls2, Succeeded) @@ -1156,8 +1152,8 @@ rmDupLinkables already ls ********************************************************************* -} -dynLinkBCOs :: BCOOpts -> Interp -> LoaderState -> [Linkable] -> IO LoaderState -dynLinkBCOs bco_opts interp pls bcos = do +dynLinkBCOs :: Interp -> LoaderState -> [Linkable] -> IO LoaderState +dynLinkBCOs interp pls bcos = do let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos pls1 = pls { bcos_loaded = bcos_loaded' } @@ -1173,7 +1169,7 @@ dynLinkBCOs bco_opts interp pls bcos = do ae2 = foldr plusNameEnv (addr_env le1) (map bc_strs cbcs) le2 = le1 { itbl_env = ie2, addr_env = ae2 } - names_and_refs <- linkSomeBCOs bco_opts interp le2 cbcs + names_and_refs <- linkSomeBCOs interp le2 cbcs -- We only want to add the external ones to the ClosureEnv let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs @@ -1187,8 +1183,7 @@ dynLinkBCOs bco_opts interp pls bcos = do return $! pls1 { linker_env = le2 { closure_env = ce2 } } -- Link a bunch of BCOs and return references to their values -linkSomeBCOs :: BCOOpts - -> Interp +linkSomeBCOs :: Interp -> LinkerEnv -> [CompiledByteCode] -> IO [(Name,HValueRef)] @@ -1196,7 +1191,7 @@ linkSomeBCOs :: BCOOpts -- the incoming unlinked BCOs. Each gives the -- value of the corresponding unlinked BCO -linkSomeBCOs bco_opts interp le mods = foldr fun do_link mods [] +linkSomeBCOs interp le mods = foldr fun do_link mods [] where fun CompiledByteCode{..} inner accum = case bc_breaks of @@ -1211,7 +1206,7 @@ linkSomeBCOs bco_opts interp le mods = foldr fun do_link mods [] bco_ix = mkNameEnv (zip names [0..]) resolved <- sequence [ linkBCO interp le bco_ix breakarray bco | (breakarray, bco) <- flat ] - hvrefs <- createBCOs interp bco_opts resolved + hvrefs <- createBCOs interp resolved return (zip names hvrefs) -- | Useful to apply to the result of 'linkSomeBCOs' ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -11,7 +11,6 @@ module GHC.Runtime.Interpreter ( module GHC.Runtime.Interpreter.Types -- * High-level interface to the interpreter - , BCOOpts (..) , evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..) , resumeStmt , abandonStmt @@ -329,26 +328,11 @@ mkCostCentres :: Interp -> String -> [(String,String)] -> IO [RemotePtr CostCent mkCostCentres interp mod ccs = interpCmd interp (MkCostCentres mod ccs) -newtype BCOOpts = BCOOpts - { bco_n_jobs :: Int -- ^ Number of parallel jobs doing BCO serialization - } - -- | Create a set of BCOs that may be mutually recursive. -createBCOs :: Interp -> BCOOpts -> [ResolvedBCO] -> IO [HValueRef] -createBCOs interp opts rbcos = do - let n_jobs = bco_n_jobs opts - -- Serializing ResolvedBCO is expensive, so if we support doing it in parallel - if (n_jobs == 1) - then - interpCmd interp (CreateBCOs [runPut (put rbcos)]) - else do - old_caps <- getNumCapabilities - if old_caps == n_jobs - then void $ evaluate puts - else bracket_ (setNumCapabilities n_jobs) - (setNumCapabilities old_caps) - (void $ evaluate puts) - interpCmd interp (CreateBCOs puts) +createBCOs :: Interp -> [ResolvedBCO] -> IO [HValueRef] +createBCOs interp rbcos = do + -- Serializing ResolvedBCO is expensive, so we do it in parallel + interpCmd interp (CreateBCOs puts) where puts = parMap doChunk (chunkList 100 rbcos) ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -32,6 +32,9 @@ Compiler the specification described in the documentation of the `INCOHERENT` pragma. See GHC ticket #22448 for further details. +- Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``. + See GHC ticket #23049. + GHCi ~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee17001e54c3c6adccc5e3b67b629655c14da43a...5ddbf5edcb64f04b3527efcac727813080380aa6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee17001e54c3c6adccc5e3b67b629655c14da43a...5ddbf5edcb64f04b3527efcac727813080380aa6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 16:18:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 16 Mar 2023 12:18:42 -0400 Subject: [Git][ghc/ghc][master] configure: Fix FIND_CXX_STD_LIB test on Darwin Message-ID: <64134162ad0a7_37e76b3ac25440512185@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 1 changed file: - m4/fp_find_cxx_std_lib.m4 Changes: ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -4,6 +4,14 @@ # Identify which C++ standard library implementation the C++ toolchain links # against. AC_DEFUN([FP_FIND_CXX_STD_LIB],[ + # Annoyingly, Darwin's includes and APFS is + # case-insensitive. Consequently, it will end up #including the + # VERSION file generated by the configure script on the second + # and subsequent runs of the configure script. + # See #23116. + mkdir -p actest.tmp + cd actest.tmp + # If this is non-empty then assume that the user has specified these # manually. if test -z "$CXX_STD_LIB_LIBS"; then @@ -87,6 +95,9 @@ EOF rm -f actest.cpp actest.o actest fi + cd .. + rm -R actest.tmp + AC_SUBST([CXX_STD_LIB_LIBS]) AC_SUBST([CXX_STD_LIB_LIB_DIRS]) AC_SUBST([CXX_STD_LIB_DYN_LIB_DIRS]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e3ce9a4ce2509ce779102ec6f8e8ddcb676f94b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e3ce9a4ce2509ce779102ec6f8e8ddcb676f94b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 17:18:42 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 16 Mar 2023 13:18:42 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] 3 commits: Revert "WIP: Better Hash" Message-ID: <64134f7211019_37e76b3c2f5710525389@gitlab.mail> Matthew Pickering pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: c621d509 by Matthew Pickering at 2023-03-16T11:42:38+00:00 Revert "WIP: Better Hash" This reverts commit 848c2265e8ae73176b8da9065595992a0c60e640. - - - - - 94dc29de by Matthew Pickering at 2023-03-16T15:09:48+00:00 Revert "Revert "WIP: Better Hash"" This reverts commit c621d509652aed33a6f067e462d2f66ed4d6ac9c. - - - - - 6cba1aee by Matthew Pickering at 2023-03-16T17:17:59+00:00 wip for rodrigo - - - - - 6 changed files: - hadrian/hadrian.cabal - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Package/Hash.hs → hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Rules.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -55,6 +55,7 @@ executable hadrian , Hadrian.BuildPath , Hadrian.Expression , Hadrian.Haskell.Cabal + , Hadrian.Haskell.Hash , Hadrian.Haskell.Cabal.Type , Hadrian.Haskell.Cabal.Parse , Hadrian.Oracles.ArgsHash ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : Hadrian.Haskell.Cabal @@ -11,7 +13,7 @@ ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( pkgVersion, pkgIdentifier, pkgSynopsis, pkgDescription, pkgDependencies, - pkgGenericDescription, cabalArchString, cabalOsString, + pkgGenericDescription, cabalArchString, cabalOsString ) where import Development.Shake @@ -21,6 +23,25 @@ import Hadrian.Haskell.Cabal.Type import Hadrian.Oracles.Cabal import Hadrian.Package +import Hadrian.Haskell.Cabal.Type +import Hadrian.Oracles.Cabal +import Hadrian.Package +import Development.Shake + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as BS +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import Data.List +import Context.Type +import Oracles.Setting +import Hadrian.Target +import Hadrian.Expression + + -- | Read a Cabal file and return the package version. The Cabal file is tracked. pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData @@ -72,3 +93,4 @@ cabalOsString "mingw32" = "windows" cabalOsString "darwin" = "osx" cabalOsString "solaris2" = "solaris" cabalOsString other = other + ===================================== hadrian/src/Hadrian/Package/Hash.hs → hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -1,21 +1,51 @@ -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} -module Hadrian.Package.Hash where +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where + +import Development.Shake +import Distribution.PackageDescription (GenericPackageDescription) import Hadrian.Haskell.Cabal.Type +import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal import Hadrian.Package +import Hadrian.Haskell.Cabal.Type +import Hadrian.Oracles.Cabal +import Hadrian.Package +import Development.Shake + import qualified Crypto.Hash.SHA256 as SHA256 import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BS +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import Data.List +import Context.Type +import Oracles.Setting +import Hadrian.Target +import Hadrian.Expression +import Builder +import Flavour.Type +import Settings +import Way.Type +import Way +import Packages +import Development.Shake.Classes +import Control.Monad + -- | Compute the unit-id of a package -pkgUnitId :: Package -> String -pkgUnitId pkg = do - pid <- pkgIdentifier pkg - phash <- pkgHash pkg - pure $ pkgId <> "-" <> hash +-- This needs to be an oracle so it's cached +pkgUnitId :: Context -> Action String +pkgUnitId ctx = do + pid <- pkgIdentifier (package ctx) + phash <- pkgHash ctx + liftIO $ print phash + pure $ pid -- <> "-" <> phash data PackageHashInputs = PackageHashInputs { @@ -23,7 +53,7 @@ data PackageHashInputs = PackageHashInputs { pkgHashComponent :: PackageType, pkgHashSourceHash :: BS.ByteString, -- pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion), - pkgHashDirectDeps :: [PackageName], -- Set InstalledPackageId, -- pkgDependencies are names only, not their installed unit-ids + pkgHashDirectDeps :: Set.Set String, pkgHashOtherConfig :: PackageHashConfigInputs } @@ -34,7 +64,7 @@ data PackageHashInputs = PackageHashInputs { data PackageHashConfigInputs = PackageHashConfigInputs { pkgHashCompilerId :: String, pkgHashPlatform :: String, - -- pkgHashFlagAssignment :: FlagAssignment, -- complete not partial + pkgHashFlagAssignment :: [String], -- complete not partial -- pkgHashConfigureScriptArgs :: [String], -- just ./configure for build-type Configure pkgHashVanillaLib :: Bool, pkgHashSharedLib :: Bool, @@ -43,38 +73,94 @@ data PackageHashConfigInputs = PackageHashConfigInputs { pkgHashGHCiLib :: Bool, pkgHashProfLib :: Bool, pkgHashProfExe :: Bool, - pkgHashProfLibDetail :: ProfDetailLevel, - pkgHashProfExeDetail :: ProfDetailLevel, +-- pkgHashProfLibDetail :: ProfDetailLevel, +-- pkgHashProfExeDetail :: ProfDetailLevel, pkgHashCoverage :: Bool, - pkgHashOptimization :: OptimisationLevel, + pkgHashOptimization :: Int, pkgHashSplitObjs :: Bool, pkgHashSplitSections :: Bool, pkgHashStripLibs :: Bool, pkgHashStripExes :: Bool, - pkgHashDebugInfo :: DebugInfoLevel, +-- pkgHashDebugInfo :: DebugInfoLevel, pkgHashProgramArgs :: Map String [String], pkgHashExtraLibDirs :: [FilePath], pkgHashExtraLibDirsStatic :: [FilePath], pkgHashExtraFrameworkDirs :: [FilePath], - pkgHashExtraIncludeDirs :: [FilePath], + pkgHashExtraIncludeDirs :: [FilePath] -- pkgHashProgPrefix :: Maybe PathTemplate, -- pkgHashProgSuffix :: Maybe PathTemplate, - pkgHashPackageDbs :: [Maybe PackageDB] + -- pkgHashPackageDbs :: [Maybe PackageDB] } deriving Show -pkgHash :: Package -> Action String -pkgHash pkg = BS.unpack $ Base16.encode $ SHA256.hash $ do - pkgIdentifier - renderPackageHashInputs $ PackageHashInputs +newtype PkgHashKey = PkgHashKey Context + deriving (Binary, Eq, Hashable, NFData, Show, Typeable) +type instance RuleResult PkgHashKey = String + +pkgHash :: Context -> Action String +pkgHash = askOracle . PkgHashKey + +-- TODO: Needs to be oracle to be cached? Called lots of times +pkgHashOracle :: Rules () +pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do + ctx_data <- readContextData ctx + pkg_data <- readPackageData (package ctx) + name <- pkgIdentifier (package ctx) + let stag = stage ctx + liftIO $ print (package ctx, packageDependencies pkg_data) + stagePkgs <- stagePackages stag + foos <- mapM (\pkg -> pkgHash (ctx { package = pkg })) [pkg | pkg <- packageDependencies pkg_data, pkg `elem` stagePkgs] + liftIO $ print (foos) + flav <- flavour + let flavourArgs = args flav + + targetOs <- setting TargetOs + let pkgHashCompilerId = "" + pkgHashPlatform = targetOs + libWays <- interpretInContext ctx (libraryWays flav) + dyn_ghc <- dynamicGhcPrograms flav + flags <- interpret (target ctx (Cabal Flags stag) [] []) flavourArgs + let pkgHashFlagAssignment = flags + pkgHashConfigureScriptArgs = "" + pkgHashVanillaLib = vanilla `Set.member` libWays + pkgHashSharedLib = dynamic `Set.member` libWays + pkgHashDynExe = dyn_ghc + -- TODO: fullyStatic flavour transformer + pkgHashFullyStaticExe = False + pkgHashGHCiLib = False + pkgHashProfLib = profiling `Set.member` libWays + pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag + pkgHashCoverage = False -- Can't configure this + pkgHashOptimization = 0 -- TODO: A bit tricky to configure + pkgHashSplitObjs = False -- Deprecated + pkgHashSplitSections = ghcSplitSections flav + pkgHashStripExes = False + pkgHashStripLibs = False + pkgHashDebugInfo = undefined + + ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs + let pkgHashProgramArgs = Map.singleton "ghc" ghcArgs + pkgHashExtraLibDirs = [] + pkgHashExtraLibDirsStatic = [] + pkgHashExtraFrameworkDirs = [] + pkgHashExtraIncludeDirs = [] + + let other_config = PackageHashConfigInputs{..} + + return $ BS.unpack $ Base16.encode $ SHA256.hash $ + renderPackageHashInputs $ PackageHashInputs { - pkgHashPkgId = undefined - , pkgHashComponent = undefined - , pkgHashSourceHash = undefined - , pkgHashDirectDeps = undefined - , pkgHashOtherConfig = undefined + pkgHashPkgId = name + , pkgHashComponent = (pkgType (package ctx)) + , pkgHashSourceHash = "" + , pkgHashDirectDeps = Set.empty + , pkgHashOtherConfig = other_config } +prettyShow :: Show a => a -> String +prettyShow = show +showHashValue = show + renderPackageHashInputs :: PackageHashInputs -> BS.ByteString renderPackageHashInputs PackageHashInputs{ pkgHashPkgId, @@ -90,21 +176,23 @@ renderPackageHashInputs PackageHashInputs{ -- unnecessarily when new configuration inputs are added into the hash. BS.pack $ unlines $ catMaybes $ [ entry "pkgid" prettyShow pkgHashPkgId - , mentry "component" show pkgHashComponent +-- , mentry "component" show pkgHashComponent , entry "src" showHashValue pkgHashSourceHash + {- , entry "pkg-config-deps" (intercalate ", " . map (\(pn, mb_v) -> prettyShow pn ++ case mb_v of Nothing -> "" Just v -> " " ++ prettyShow v) . Set.toList) pkgHashPkgConfigDeps + -} , entry "deps" (intercalate ", " . map prettyShow . Set.toList) pkgHashDirectDeps -- and then all the config , entry "compilerid" prettyShow pkgHashCompilerId , entry "platform" prettyShow pkgHashPlatform - , opt "flags" mempty showFlagAssignment pkgHashFlagAssignment - , opt "configure-script" [] unwords pkgHashConfigureScriptArgs + , opt "flags" mempty show pkgHashFlagAssignment +-- , opt "configure-script" [] unwords pkgHashConfigureScriptArgs , opt "vanilla-lib" True prettyShow pkgHashVanillaLib , opt "shared-lib" False prettyShow pkgHashSharedLib , opt "dynamic-exe" False prettyShow pkgHashDynExe @@ -112,22 +200,22 @@ renderPackageHashInputs PackageHashInputs{ , opt "ghci-lib" False prettyShow pkgHashGHCiLib , opt "prof-lib" False prettyShow pkgHashProfLib , opt "prof-exe" False prettyShow pkgHashProfExe - , opt "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail - , opt "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail + -- , opt "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail + -- , opt "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail , opt "hpc" False prettyShow pkgHashCoverage - , opt "optimisation" NormalOptimisation (show . fromEnum) pkgHashOptimization + , opt "optimisation" 0 (show) pkgHashOptimization , opt "split-objs" False prettyShow pkgHashSplitObjs , opt "split-sections" False prettyShow pkgHashSplitSections , opt "stripped-lib" False prettyShow pkgHashStripLibs , opt "stripped-exe" True prettyShow pkgHashStripExes - , opt "debug-info" NormalDebugInfo (show . fromEnum) pkgHashDebugInfo +-- , opt "debug-info" NormalDebugInfo (show . fromEnum) pkgHashDebugInfo , opt "extra-lib-dirs" [] unwords pkgHashExtraLibDirs , opt "extra-lib-dirs-static" [] unwords pkgHashExtraLibDirsStatic , opt "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs , opt "extra-include-dirs" [] unwords pkgHashExtraIncludeDirs - , opt "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix - , opt "prog-suffix" Nothing (maybe "" fromPathTemplate) pkgHashProgSuffix - , opt "package-dbs" [] (unwords . map show) pkgHashPackageDbs +-- , opt "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix +-- , opt "prog-suffix" Nothing (maybe "" fromPathTemplate) pkgHashProgSuffix +-- , opt "package-dbs" [] (unwords . map show) pkgHashPackageDbs ] ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs where ===================================== hadrian/src/Rules.hs ===================================== @@ -8,6 +8,7 @@ import qualified Hadrian.Oracles.Cabal.Rules import qualified Hadrian.Oracles.DirectoryContents import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile +import qualified Hadrian.Haskell.Hash import Expression import qualified Oracles.Flavour @@ -142,6 +143,7 @@ oracleRules :: Rules () oracleRules = do Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs Hadrian.Oracles.Cabal.Rules.cabalOracle + Hadrian.Haskell.Hash.pkgHashOracle Hadrian.Oracles.DirectoryContents.directoryContentsOracle Hadrian.Oracles.Path.pathOracle Hadrian.Oracles.TextFile.textFileOracle ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -14,6 +14,8 @@ import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting import Hadrian.Haskell.Cabal.Type (PackageData(version)) +import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Hash import Hadrian.Oracles.Cabal (readPackageData) import Packages import Rules.Libffi @@ -493,7 +495,7 @@ generateConfigHs = do -- part of the WiringMap, so we don't to go back and forth between the -- unit-id and the unit-key -- we take care that they are the same by using -- 'pkgUnitId' to create the unit-id in both situations. - cProjectUnitId <- pkgUnitId <$> getPackage + cProjectUnitId <- expr . pkgUnitId =<< getContext return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -591,3 +593,4 @@ generatePlatformHostHs = do , "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS" ] + ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -3,6 +3,7 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Hash import Hadrian.Haskell.Cabal.Type import Flavour @@ -14,6 +15,7 @@ import Rules.Libffi (libffiName) import qualified Data.Set as Set import System.Directory import Data.Version.Extra +import Hadrian.Haskell.Hash ghcBuilderArgs :: Args ghcBuilderArgs = mconcat @@ -248,6 +250,7 @@ wayGhcArgs = do packageGhcArgs :: Args packageGhcArgs = do package <- getPackage + ctx <- getContext ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) -- ROMES: Until the boot compiler no longer needs ghc's -- unit-id to be "ghc", the stage0 compiler must be built @@ -259,7 +262,7 @@ packageGhcArgs = do -- building stage0 because we have a flag in compiler/ghc.cabal.in that is -- sets `-this-unit-id ghc` when hadrian is building stage0, which will -- overwrite this one. - pkgId <- expr $ pkgUnitId package + pkgId <- expr $ pkgUnitId ctx mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/848c2265e8ae73176b8da9065595992a0c60e640...6cba1aeeb424db7dadb997d68a0cc66f853b6642 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/848c2265e8ae73176b8da9065595992a0c60e640...6cba1aeeb424db7dadb997d68a0cc66f853b6642 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 18:29:55 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 16 Mar 2023 14:29:55 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 2 commits: compiler: Implement atomicSwapIORef with xchg Message-ID: <64136023aaa3_37e76b3d7022805313c@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: e4a2f829 by Ben Gamari at 2023-03-16T14:29:49-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - 80c09bf8 by Ben Gamari at 2023-03-16T14:29:49-04:00 testsuite: Add test for atomicSwapIORef# - - - - - 8 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/GHC/IORef.hs - + libraries/base/tests/AtomicSwapIORef.hs - libraries/base/tests/all.T - rts/PrimOps.cmm - rts/include/Cmm.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2464,6 +2464,13 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp + MutVar# s v -> v -> State# s -> (# State# s, v #) + {Atomically exchange the value of a 'MutVar#'.} + with + out_of_line = True + has_side_effects = True + -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1559,6 +1559,7 @@ emitPrimOp cfg primop = ResizeMutableByteArrayOp_Char -> alwaysExternal ShrinkSmallMutableArrayOp_Char -> alwaysExternal NewMutVarOp -> alwaysExternal + AtomicSwapMutVarOp -> alwaysExternal AtomicModifyMutVar2Op -> alwaysExternal AtomicModifyMutVar_Op -> alwaysExternal CasMutVarOp -> alwaysExternal ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -859,6 +859,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[status,r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -28,6 +28,7 @@ module GHC.IORef ( import GHC.Base import GHC.STRef import GHC.IO +import GHC.Prim (atomicSwapMutVar#) -- --------------------------------------------------------------------------- -- IORefs @@ -127,10 +128,9 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a --- Bad implementation! This will be a primop shortly. atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicModifyMutVar2# ref (\_old -> Box new) s of - (# s', old, Box _new #) -> (# s', old #) + case atomicSwapMutVar# ref new s of + (# s', old #) -> (# s', old #) data Box a = Box a ===================================== libraries/base/tests/AtomicSwapIORef.hs ===================================== @@ -0,0 +1,7 @@ +import Data.IORef + +main :: IO () +main = do + r <- newIORef 42 :: IO Int + atomicSwapIORef r 43 + readIORef r >>= print ===================================== libraries/base/tests/all.T ===================================== @@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('AtomicSwapIORef', normal, compile_and_run, ['']) ===================================== rts/PrimOps.cmm ===================================== @@ -689,6 +689,14 @@ stg_newMutVarzh ( gcptr init ) return (mv); } +stg_swapMutVarzh ( gcptr mv, gcptr old ) + /* MutVar# s a -> a -> State# s -> (# State#, a #) */ +{ + W_ new; + (new) = prim %xchgW(mv+OFFSET_StgMutVar_var, old); + return (new); +} + // RRN: To support the "ticketed" approach, we return the NEW rather // than old value if the CAS is successful. This is received in an // opaque form in the Haskell code, preventing the compiler from ===================================== rts/include/Cmm.h ===================================== @@ -193,8 +193,10 @@ #if SIZEOF_W == 4 #define cmpxchgW cmpxchg32 +#define xchgW xchg32 #elif SIZEOF_W == 8 #define cmpxchgW cmpxchg64 +#define xchgW xchg64 #endif /* ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c69091a1d39351bb5695bf1ff9e0151dda7b6078...80c09bf88a47ef9b14d094d6d723b0b1c03abaf6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c69091a1d39351bb5695bf1ff9e0151dda7b6078...80c09bf88a47ef9b14d094d6d723b0b1c03abaf6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 19:54:48 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Thu, 16 Mar 2023 15:54:48 -0400 Subject: [Git][ghc/ghc][wip/supersven/StgRetBCO-struct] 88 commits: Fix typo in docs referring to threadLabel Message-ID: <64137408a5714_37e76b3edfab545363fb@gitlab.mail> Sven Tennie pushed to branch wip/supersven/StgRetBCO-struct at Glasgow Haskell Compiler / GHC Commits: c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 9d1accff by Sven Tennie at 2023-03-16T19:54:23+00:00 Scav.c - - - - - 2593186b by Sven Tennie at 2023-03-16T19:54:23+00:00 Use closure size instead of addresses - - - - - 2eb13799 by Sven Tennie at 2023-03-16T19:54:23+00:00 Add TODOs - - - - - c289e317 by Sven Tennie at 2023-03-16T19:54:23+00:00 Compact.c - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/TmpFs.hs - configure.ac - distrib/configure.ac.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8f1a6a0d9cda2acc485c9b5a4b404b0e5349c49...c289e31721ac471b78a106c652e6409dcc6d51da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8f1a6a0d9cda2acc485c9b5a4b404b0e5349c49...c289e31721ac471b78a106c652e6409dcc6d51da You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 23:41:37 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 16 Mar 2023 19:41:37 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] 82 commits: Add `Data.Functor.unzip` Message-ID: <6413a931b08fb_1bf010aa990c999c9@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - e25585e9 by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - 215c42f5 by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 Wibbles - - - - - e282fa3d by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 DRAFT: Refactor the way we establish a canonical constraint Relevant to #22194 Incomplete; but I'd like to see the CI results - - - - - 2b9f0f59 by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 Wibbles - - - - - a67e4a42 by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 Wibbles - - - - - f3f5643a by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 Wibbles - - - - - fe1fab7c by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 Use a flag-based approach for checkTyEqRhs ...looks much nicer - - - - - 518dd328 by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 Wibble - - - - - 0a3b0aec by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 Bug fixes - - - - - 63f48d60 by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 More bug fixes - - - - - 351b7552 by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 Minor fixes - - - - - b2589cca by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 Fix isConcreteTyCon Adds a synIsConcrete to SynonymTyCon - - - - - dd9146d4 by Simon Peyton Jones at 2023-03-15T23:22:45+00:00 More wibbles - - - - - 80ec3dc2 by Simon Peyton Jones at 2023-03-16T23:21:36+00:00 Add a fast path simpleUnifyCheck - - - - - 17 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Solver.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/440df186631c058618eb46b4d2e36540e5b7291c...80ec3dc232cfc3bba680c29b53af12b38012e674 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/440df186631c058618eb46b4d2e36540e5b7291c...80ec3dc232cfc3bba680c29b53af12b38012e674 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 16 23:59:20 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 16 Mar 2023 19:59:20 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Wibble Message-ID: <6413ad5862fbf_1bf010de02c41003ba@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: eae273aa by Simon Peyton Jones at 2023-03-17T00:00:45+00:00 Wibble - - - - - 1 changed file: - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2580,7 +2580,7 @@ simpleUnifyCheck fam_ok lhs_tv rhs go w && go a && go r go (TyConApp tc tys) | lhs_tv_is_concrete, not (isConcreteTyCon tc) = False - | isTypeFamilyTyCon, not fam_ok = False + | not fam_ok, isTypeFamilyTyCon tc = False | otherwise = all go tys go (AppTy t1 t2) = go t1 && go t2 go (ForAllTy {}) = False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eae273aab82d12d5de0611c7beee0c67dbeb4ad6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eae273aab82d12d5de0611c7beee0c67dbeb4ad6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 17 10:51:11 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 17 Mar 2023 06:51:11 -0400 Subject: [Git][ghc/ghc][wip/jsem] Implement -jsem: parallelism controlled by semaphores Message-ID: <6414461f82093_20ac841798f141026d0@gitlab.mail> Matthew Pickering pushed to branch wip/jsem at Glasgow Haskell Compiler / GHC Commits: b0db02e7 by sheaf at 2023-03-17T10:50:47+00:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Fixes #19349 - - - - - 14 changed files: - .gitmodules - cabal.project-reinstall - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/ghc.cabal.in - docs/users_guide/using.rst - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - + libraries/semaphore-compat - packages Changes: ===================================== .gitmodules ===================================== @@ -83,6 +83,10 @@ url = https://gitlab.haskell.org/ghc/packages/unix.git ignore = untracked branch = 2.7 +[submodule "libraries/semaphore-compat"] + path = libraries/semaphore-compat + url = https://gitlab.haskell.org/ghc/semaphore-compat.git + ignore = untracked [submodule "libraries/stm"] path = libraries/stm url = https://gitlab.haskell.org/ghc/packages/stm.git ===================================== cabal.project-reinstall ===================================== @@ -28,6 +28,7 @@ packages: ./compiler ./libraries/parsec/ -- ./libraries/pretty/ ./libraries/process/ + ./libraries/semaphore-compat ./libraries/stm -- ./libraries/template-haskell/ ./libraries/terminfo/ ===================================== compiler/GHC/Driver/Config.hs ===================================== @@ -38,8 +38,9 @@ initBCOOpts dflags = do -- Serializing ResolvedBCO is expensive, so if we're in parallel mode -- (-j) parallelise the serialization. n_jobs <- case parMakeCount dflags of - Nothing -> liftIO getNumProcessors - Just n -> return n + Nothing -> pure 1 + Just (ParMakeThisMany n) -> pure n + Just ParMakeNumProcessors -> liftIO getNumProcessors return $ BCOOpts n_jobs -- | Extract GHCi options from DynFlags and step ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -75,6 +75,7 @@ import GHC.Driver.Env import GHC.Driver.Errors import GHC.Driver.Errors.Types import GHC.Driver.Main +import GHC.Driver.MakeSem import GHC.Parser.Header @@ -149,9 +150,9 @@ import GHC.Runtime.Loader import GHC.Rename.Names import GHC.Utils.Constants import GHC.Types.Unique.DFM (udfmRestrictKeysSet) -import qualified Data.IntSet as I import GHC.Types.Unique +import qualified Data.IntSet as I -- ----------------------------------------------------------------------------- -- Loading the program @@ -657,6 +658,31 @@ createBuildPlan mod_graph maybe_top_mod = (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (length (mgModSummaries' mod_graph )))]) build_plan +mkWorkerLimit :: DynFlags -> IO WorkerLimit +mkWorkerLimit dflags = + case jsemHandle dflags of + Just h -> pure (JSemLimit $ SemaphoreName h) + Nothing -> case parMakeCount dflags of + Nothing -> pure $ num_procs 1 + Just ParMakeNumProcessors -> num_procs <$> getNumProcessors + Just (ParMakeThisMany n) -> pure $ num_procs n + where + num_procs x = NumProcessorsLimit (max 1 x) + +isWorkerLimitSequential :: WorkerLimit -> Bool +isWorkerLimitSequential (NumProcessorsLimit x) = x <= 1 +isWorkerLimitSequential (JSemLimit {}) = False + +-- | This describes what we use to limit the number of jobs, either we limit it +-- ourselves to a specific number or we have an external parallelism semaphore +-- limit it for us. +data WorkerLimit + = NumProcessorsLimit Int + | JSemLimit + SemaphoreName + -- ^ Semaphore name to use + deriving Eq + -- | Generalized version of 'load' which also supports a custom -- 'Messager' (for reporting progress) and 'ModuleGraph' (generally -- produced by calling 'depanal'. @@ -737,14 +763,12 @@ load' mhmi_cache how_much mHscMessage mod_graph = do liftIO $ debugTraceMsg logger 2 (hang (text "Ready for upsweep") 2 (ppr build_plan)) - n_jobs <- case parMakeCount (hsc_dflags hsc_env) of - Nothing -> liftIO getNumProcessors - Just n -> return n + worker_limit <- liftIO $ mkWorkerLimit dflags setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do hsc_env <- getSession - liftIO $ upsweep n_jobs hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan + liftIO $ upsweep worker_limit hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan setSession hsc_env1 case upsweep_ok of Failed -> loadFinish upsweep_ok @@ -1029,13 +1053,7 @@ getDependencies direct_deps build_map = type BuildM a = StateT BuildLoopState IO a --- | Abstraction over the operations of a semaphore which allows usage with the --- -j1 case -data AbstractSem = AbstractSem { acquireSem :: IO () - , releaseSem :: IO () } -withAbstractSem :: AbstractSem -> IO b -> IO b -withAbstractSem sem = MC.bracket_ (acquireSem sem) (releaseSem sem) -- | Environment used when compiling a module data MakeEnv = MakeEnv { hsc_env :: !HscEnv -- The basic HscEnv which will be augmented for each module @@ -1220,7 +1238,7 @@ withCurrentUnit uid = do local (\env -> env { hsc_env = hscSetActiveUnitId uid (hsc_env env)}) upsweep - :: Int -- ^ The number of workers we wish to run in parallel + :: WorkerLimit -- ^ The number of workers we wish to run in parallel -> HscEnv -- ^ The base HscEnv, which is augmented for each module -> Maybe ModIfaceCache -- ^ A cache to incrementally write final interface files to -> Maybe Messager @@ -2825,7 +2843,7 @@ label_self thread_name = do CC.labelThread self_tid thread_name -runPipelines :: Int -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () +runPipelines :: WorkerLimit -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () -- Don't even initialise plugins if there are no pipelines runPipelines _ _ _ [] = return () runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do @@ -2833,7 +2851,7 @@ runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do plugins_hsc_env <- initializePlugins orig_hsc_env case n_job of - 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines + NumProcessorsLimit n | n <= 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines _n -> runParPipelines n_job plugins_hsc_env mHscMessager all_pipelines runSeqPipelines :: HscEnv -> Maybe Messager -> [MakeAction] -> IO () @@ -2843,16 +2861,38 @@ runSeqPipelines plugin_hsc_env mHscMessager all_pipelines = , compile_sem = AbstractSem (return ()) (return ()) , env_messager = mHscMessager } - in runAllPipelines 1 env all_pipelines + in runAllPipelines (NumProcessorsLimit 1) env all_pipelines +runNjobsAbstractSem :: Int -> (AbstractSem -> IO a) -> IO a +runNjobsAbstractSem n_jobs action = do + compile_sem <- newQSem n_jobs + n_capabilities <- getNumCapabilities + n_cpus <- getNumProcessors + let + asem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + set_num_caps n = unless (n_capabilities /= 1) $ setNumCapabilities n + updNumCapabilities = do + -- Setting number of capabilities more than + -- CPU count usually leads to high userspace + -- lock contention. #9221 + set_num_caps $ min n_jobs n_cpus + resetNumCapabilities = set_num_caps n_capabilities + MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem + +runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a +runWorkerLimit worker_limit action = case worker_limit of + NumProcessorsLimit n_jobs -> + runNjobsAbstractSem n_jobs action + JSemLimit sem -> + runJSemAbstractSem sem action -- | Build and run a pipeline -runParPipelines :: Int -- ^ How many capabilities to use - -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module +runParPipelines :: WorkerLimit -- ^ How to limit work parallelism + -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module -> Maybe Messager -- ^ Optional custom messager to use to report progress -> [MakeAction] -- ^ The build plan for all the module nodes -> IO () -runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do +runParPipelines worker_limit plugin_hsc_env mHscMessager all_pipelines = do -- A variable which we write to when an error has happened and we have to tell the @@ -2862,39 +2902,23 @@ runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do -- will add it's LogQueue into this queue. log_queue_queue_var <- newTVarIO newLogQueueQueue -- Thread which coordinates the printing of logs - wait_log_thread <- logThread n_jobs (length all_pipelines) (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var + wait_log_thread <- logThread (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var -- Make the logger thread-safe, in case there is some output which isn't sent via the LogQueue. thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env) let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger } - let updNumCapabilities = liftIO $ do - n_capabilities <- getNumCapabilities - n_cpus <- getNumProcessors - -- Setting number of capabilities more than - -- CPU count usually leads to high userspace - -- lock contention. #9221 - let n_caps = min n_jobs n_cpus - unless (n_capabilities /= 1) $ setNumCapabilities n_caps - return n_capabilities - - let resetNumCapabilities orig_n = do - liftIO $ setNumCapabilities orig_n - atomically $ writeTVar stopped_var True - wait_log_thread - - compile_sem <- newQSem n_jobs - let abstract_sem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + runWorkerLimit worker_limit $ \abstract_sem -> do + let env = MakeEnv { hsc_env = thread_safe_hsc_env + , withLogger = withParLog log_queue_queue_var + , compile_sem = abstract_sem + , env_messager = mHscMessager + } -- Reset the number of capabilities once the upsweep ends. - let env = MakeEnv { hsc_env = thread_safe_hsc_env - , withLogger = withParLog log_queue_queue_var - , compile_sem = abstract_sem - , env_messager = mHscMessager - } - - MC.bracket updNumCapabilities resetNumCapabilities $ \_ -> - runAllPipelines n_jobs env all_pipelines + runAllPipelines worker_limit env all_pipelines + atomically $ writeTVar stopped_var True + wait_log_thread withLocalTmpFS :: RunMakeM a -> RunMakeM a withLocalTmpFS act = do @@ -2911,10 +2935,11 @@ withLocalTmpFS act = do MC.bracket initialiser finaliser $ \lcl_hsc_env -> local (\env -> env { hsc_env = lcl_hsc_env}) act -- | Run the given actions and then wait for them all to finish. -runAllPipelines :: Int -> MakeEnv -> [MakeAction] -> IO () -runAllPipelines n_jobs env acts = do - let spawn_actions :: IO [ThreadId] - spawn_actions = if n_jobs == 1 +runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO () +runAllPipelines worker_limit env acts = do + let single_worker = isWorkerLimitSequential worker_limit + spawn_actions :: IO [ThreadId] + spawn_actions = if single_worker then (:[]) <$> (forkIOWithUnmask $ \unmask -> void $ runLoop (\io -> io unmask) env acts) else runLoop forkIOWithUnmask env acts ===================================== compiler/GHC/Driver/MakeSem.hs ===================================== @@ -0,0 +1,548 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE NumericUnderscores #-} + +-- | Implementation of a jobserver using system semaphores. +-- +-- +module GHC.Driver.MakeSem + ( -- * JSem: parallelism semaphore backed + -- by a system semaphore (Posix/Windows) + runJSemAbstractSem + + -- * System semaphores + , Semaphore, SemaphoreName(..) + + -- * Abstract semaphores + , AbstractSem(..) + , withAbstractSem + ) + where + +import GHC.Prelude +import GHC.Conc +import GHC.Data.OrdList +import GHC.IO.Exception +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Json + +import System.Semaphore + +import Control.Monad +import qualified Control.Monad.Catch as MC +import Control.Concurrent.MVar +import Control.Concurrent.STM +import Data.Foldable +import Data.Functor +import GHC.Stack +import Debug.Trace + +--------------------------------------- +-- Semaphore jobserver + +-- | A jobserver based off a system 'Semaphore'. +-- +-- Keeps track of the pending jobs and resources +-- available from the semaphore. +data Jobserver + = Jobserver + { jSemaphore :: !Semaphore + -- ^ The semaphore which controls available resources + , jobs :: !(TVar JobResources) + -- ^ The currently pending jobs, and the resources + -- obtained from the semaphore + } + +data JobserverOptions + = JobserverOptions + { releaseDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between acquiring a token + -- and releasing a token. + , setNumCapsDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between two consecutive + -- calls of 'setNumCapabilities'. + } + +defaultJobserverOptions :: JobserverOptions +defaultJobserverOptions = + JobserverOptions + { releaseDebounce = 1000 -- 1 second + , setNumCapsDebounce = 1000 -- 1 second + } + +-- | Resources available for running jobs, i.e. +-- tokens obtained from the parallelism semaphore. +data JobResources + = Jobs + { tokensOwned :: !Int + -- ^ How many tokens have been claimed from the semaphore + , tokensFree :: !Int + -- ^ How many tokens are not currently being used + , jobsWaiting :: !(OrdList (TMVar ())) + -- ^ Pending jobs waiting on a token, the job will be blocked on the TMVar so putting into + -- the TMVar will allow the job to continue. + } + +instance Outputable JobResources where + ppr Jobs{..} + = text "JobResources" <+> + ( braces $ hsep + [ text "owned=" <> ppr tokensOwned + , text "free=" <> ppr tokensFree + , text "num_waiting=" <> ppr (length jobsWaiting) + ] ) + +-- | Add one new token. +addToken :: JobResources -> JobResources +addToken jobs@( Jobs { tokensOwned = owned, tokensFree = free }) + = jobs { tokensOwned = owned + 1, tokensFree = free + 1 } + +-- | Free one token. +addFreeToken :: JobResources -> JobResources +addFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (tokensOwned jobs > free) + (text "addFreeToken:" <+> ppr (tokensOwned jobs) <+> ppr free) + $ jobs { tokensFree = free + 1 } + +-- | Use up one token. +removeFreeToken :: JobResources -> JobResources +removeFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (free > 0) + (text "removeFreeToken:" <+> ppr free) + $ jobs { tokensFree = free - 1 } + +-- | Return one owned token. +removeOwnedToken :: JobResources -> JobResources +removeOwnedToken jobs@( Jobs { tokensOwned = owned }) + = assertPpr (owned > 1) + (text "removeOwnedToken:" <+> ppr owned) + $ jobs { tokensOwned = owned - 1 } + +-- | Add one new job to the end of the list of pending jobs. +addJob :: TMVar () -> JobResources -> JobResources +addJob job jobs@( Jobs { jobsWaiting = wait }) + = jobs { jobsWaiting = wait `SnocOL` job } + +-- | The state of the semaphore job server. +data JobserverState + = JobserverState + { jobserverAction :: !JobserverAction + -- ^ The current action being performed by the + -- job server. + , canChangeNumCaps :: !(TVar Bool) + -- ^ A TVar that signals whether it has been long + -- enough since we last changed 'numCapabilities'. + , canReleaseToken :: !(TVar Bool) + -- ^ A TVar that signals whether we last acquired + -- a token long enough ago that we can now release + -- a token. + } +data JobserverAction + -- | The jobserver is idle: no thread is currently + -- interacting with the semaphore. + = Idle + -- | A thread is waiting for a token on the semaphore. + | Acquiring + { activeWaitId :: WaitId + , threadFinished :: TMVar (Maybe MC.SomeException) } + +-- | Retrieve the 'TMVar' that signals if the current thread has finished, +-- if any thread is currently active in the jobserver. +activeThread_maybe :: JobserverAction -> Maybe (TMVar (Maybe MC.SomeException)) +activeThread_maybe Idle = Nothing +activeThread_maybe (Acquiring { threadFinished = tmvar }) = Just tmvar + +-- | Whether we should try to acquire a new token from the semaphore: +-- there is a pending job and no free tokens. +guardAcquire :: JobResources -> Bool +guardAcquire ( Jobs { tokensFree, jobsWaiting } ) + = tokensFree == 0 && not (null jobsWaiting) + +-- | Whether we should release a token from the semaphore: +-- there are no pending jobs and we can release a token. +guardRelease :: JobResources -> Bool +guardRelease ( Jobs { tokensFree, tokensOwned, jobsWaiting } ) + = null jobsWaiting && tokensFree > 0 && tokensOwned > 1 + +--------------------------------------- +-- Semaphore jobserver implementation + +-- | Add one pending job to the jobserver. +-- +-- Blocks, waiting on the jobserver to supply a free token. +acquireJob :: TVar JobResources -> IO () +acquireJob jobs_tvar = do + (job_tmvar, _jobs0) <- tracedAtomically "acquire" $ + modifyJobResources jobs_tvar \ jobs -> do + job_tmvar <- newEmptyTMVar + return ((job_tmvar, jobs), addJob job_tmvar jobs) + atomically $ takeTMVar job_tmvar + +-- | Signal to the job server that one job has completed, +-- releasing its corresponding token. +releaseJob :: TVar JobResources -> IO () +releaseJob jobs_tvar = do + tracedAtomically "release" do + modifyJobResources jobs_tvar \ jobs -> do + massertPpr (tokensFree jobs < tokensOwned jobs) + (text "releaseJob: more free jobs than owned jobs!") + return ((), addFreeToken jobs) + + +-- | Release all tokens owned from the semaphore (to clean up +-- the jobserver at the end). +cleanupJobserver :: Jobserver -> IO () +cleanupJobserver (Jobserver { jSemaphore = sem + , jobs = jobs_tvar }) + = do + Jobs { tokensOwned = owned } <- readTVarIO jobs_tvar + let toks_to_release = owned - 1 + -- Subtract off the implicit token: whoever spawned the ghc process + -- in the first place is responsible for that token. + releaseSemaphore sem toks_to_release + +-- | Dispatch the available tokens acquired from the semaphore +-- to the pending jobs in the job server. +dispatchTokens :: JobResources -> STM JobResources +dispatchTokens jobs@( Jobs { tokensFree = toks_free, jobsWaiting = wait } ) + | toks_free > 0 + , next `ConsOL` rest <- wait + -- There's a pending job and a free token: + -- pass on the token to that job, and recur. + = do + putTMVar next () + let jobs' = jobs { tokensFree = toks_free - 1, jobsWaiting = rest } + dispatchTokens jobs' + | otherwise + = return jobs + +-- | Update the available resources used from a semaphore, dispatching +-- any newly acquired resources. +-- +-- Invariant: if the number of available resources decreases, there +-- must be no pending jobs. +-- +-- All modifications should go through this function to ensure the contents +-- of the 'TVar' remains in normal form. +modifyJobResources :: HasCallStack => TVar JobResources + -> (JobResources -> STM (a, JobResources)) + -> STM (a, Maybe JobResources) +modifyJobResources jobs_tvar action = do + old_jobs <- readTVar jobs_tvar + (a, jobs) <- action old_jobs + + -- Check the invariant: if the number of free tokens has decreased, + -- there must be no pending jobs. + massertPpr (null (jobsWaiting jobs) || tokensFree jobs >= tokensFree old_jobs) $ + vcat [ text "modiyJobResources: pending jobs but fewer free tokens" ] + dispatched_jobs <- dispatchTokens jobs + writeTVar jobs_tvar dispatched_jobs + return (a, Just dispatched_jobs) + + +tracedAtomically_ :: String -> STM (Maybe JobResources) -> IO () +tracedAtomically_ s act = tracedAtomically s (((),) <$> act) + +tracedAtomically :: String -> STM (a, Maybe JobResources) -> IO a +tracedAtomically origin act = do + (a, mjr) <- atomically act + forM_ mjr $ \ jr -> do + -- Use the "jsem:" prefix to identify where the write traces are + traceEventIO ("jsem:" ++ renderJobResources origin jr) + return a + +renderJobResources :: String -> JobResources -> String +renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON $ + JSObject [ ("name", JSString origin) + , ("owned", JSInt own) + , ("free", JSInt free) + , ("pending", JSInt (length pending) ) + ] + + +-- | Spawn a new thread that waits on the semaphore in order to acquire +-- an additional token. +acquireThread :: Jobserver -> IO JobserverAction +acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + let + wait_result_action :: Either MC.SomeException Bool -> IO () + wait_result_action wait_res = + tracedAtomically_ "acquire_thread" do + (r, jb) <- case wait_res of + Left (e :: MC.SomeException) -> do + return $ (Just e, Nothing) + Right success -> do + if success + then do + modifyJobResources jobs_tvar \ jobs -> + return (Nothing, addToken jobs) + else + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jb + wait_id <- forkWaitOnSemaphoreInterruptible sem wait_result_action + labelThread (waitingThreadId wait_id) "acquire_thread" + return $ Acquiring { activeWaitId = wait_id + , threadFinished = threadFinished_tmvar } + +-- | Spawn a thread to release ownership of one resource from the semaphore, +-- provided we have spare resources and no pending jobs. +releaseThread :: Jobserver -> IO JobserverAction +releaseThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + MC.mask_ do + -- Pre-release the resource so that another thread doesn't take control of it + -- just as we release the lock on the semaphore. + still_ok_to_release + <- tracedAtomically "pre_release" $ + modifyJobResources jobs_tvar \ jobs -> + if guardRelease jobs + -- TODO: should this also debounce? + then return (True , removeOwnedToken $ removeFreeToken jobs) + else return (False, jobs) + if not still_ok_to_release + then return Idle + else do + tid <- forkIO $ do + x <- MC.try $ releaseSemaphore sem 1 + tracedAtomically_ "post-release" $ do + (r, jobs) <- case x of + Left (e :: MC.SomeException) -> do + modifyJobResources jobs_tvar \ jobs -> + return (Just e, addToken jobs) + Right _ -> do + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jobs + labelThread tid "release_thread" + return Idle + +-- | When there are pending jobs but no free tokens, +-- spawn a thread to acquire a new token from the semaphore. +-- +-- See 'acquireThread'. +tryAcquire :: JobserverOptions + -> Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryAcquire opts js@( Jobserver { jobs = jobs_tvar }) + st@( JobserverState { jobserverAction = Idle } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardAcquire jobs + return do + action <- acquireThread js + -- Set a debounce after acquiring a token. + can_release_tvar <- registerDelay $ (releaseDebounce opts * 1000) + return $ st { jobserverAction = action + , canReleaseToken = can_release_tvar } +tryAcquire _ _ _ = retry + +-- | When there are free tokens and no pending jobs, +-- spawn a thread to release a token from the semamphore. +-- +-- See 'releaseThread'. +tryRelease :: Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryRelease sjs@( Jobserver { jobs = jobs_tvar } ) + st@( JobserverState + { jobserverAction = Idle + , canReleaseToken = can_release_tvar } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardRelease jobs + can_release <- readTVar can_release_tvar + guard can_release + return do + action <- releaseThread sjs + return $ st { jobserverAction = action } +tryRelease _ _ = retry + +-- | Wait for an active thread to finish. Once it finishes: +-- +-- - set the 'JobserverAction' to 'Idle', +-- - update the number of capabilities to reflect the number +-- of owned tokens from the semaphore. +tryNoticeIdle :: JobserverOptions + -> TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryNoticeIdle opts jobs_tvar jobserver_state + | Just threadFinished_tmvar <- activeThread_maybe $ jobserverAction jobserver_state + = sync_num_caps (canChangeNumCaps jobserver_state) threadFinished_tmvar + | otherwise + = retry -- no active thread: wait until jobserver isn't idle + where + sync_num_caps :: TVar Bool + -> TMVar (Maybe MC.SomeException) + -> STM (IO JobserverState) + sync_num_caps can_change_numcaps_tvar threadFinished_tmvar = do + mb_ex <- takeTMVar threadFinished_tmvar + for_ mb_ex MC.throwM + Jobs { tokensOwned } <- readTVar jobs_tvar + can_change_numcaps <- readTVar can_change_numcaps_tvar + guard can_change_numcaps + return do + x <- getNumCapabilities + can_change_numcaps_tvar_2 <- + if x == tokensOwned + then return can_change_numcaps_tvar + else do + setNumCapabilities tokensOwned + registerDelay $ (setNumCapsDebounce opts * 1000) + return $ + jobserver_state + { jobserverAction = Idle + , canChangeNumCaps = can_change_numcaps_tvar_2 } + +-- | Try to stop the current thread which is acquiring/releasing resources +-- if that operation is no longer relevant. +tryStopThread :: TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryStopThread jobs_tvar jsj = do + case jobserverAction jsj of + Acquiring { activeWaitId = wait_id } -> do + jobs <- readTVar jobs_tvar + guard $ null (jobsWaiting jobs) + return do + interruptWaitOnSemaphore wait_id + return $ jsj { jobserverAction = Idle } + _ -> retry + +-- | Main jobserver loop: acquire/release resources as +-- needed for the pending jobs and available semaphore tokens. +jobserverLoop :: JobserverOptions -> Jobserver -> IO () +jobserverLoop opts sjs@(Jobserver { jobs = jobs_tvar }) + = do + true_tvar <- newTVarIO True + let init_state :: JobserverState + init_state = + JobserverState + { jobserverAction = Idle + , canChangeNumCaps = true_tvar + , canReleaseToken = true_tvar } + loop init_state + where + loop s = do + action <- atomically $ asum $ (\x -> x s) <$> + [ tryRelease sjs + , tryAcquire opts sjs + , tryNoticeIdle opts jobs_tvar + , tryStopThread jobs_tvar + ] + s <- action + loop s + +-- | Create a new jobserver using the given semaphore handle. +makeJobserver :: SemaphoreName -> IO (AbstractSem, IO ()) +makeJobserver sem_name = do + semaphore <- openSemaphore sem_name + let + init_jobs = + Jobs { tokensOwned = 1 + , tokensFree = 1 + , jobsWaiting = NilOL + } + jobs_tvar <- newTVarIO init_jobs + let + opts = defaultJobserverOptions -- TODO: allow this to be configured + sjs = Jobserver { jSemaphore = semaphore + , jobs = jobs_tvar } + loop_finished_mvar <- newEmptyMVar + loop_tid <- forkIOWithUnmask \ unmask -> do + r <- try $ unmask $ jobserverLoop opts sjs + putMVar loop_finished_mvar $ + case r of + Left e + | Just ThreadKilled <- fromException e + -> Nothing + | otherwise + -> Just e + Right () -> Nothing + labelThread loop_tid "job_server" + let + acquireSem = acquireJob jobs_tvar + releaseSem = releaseJob jobs_tvar + cleanupSem = do + -- this is interruptible + cleanupJobserver sjs + killThread loop_tid + mb_ex <- takeMVar loop_finished_mvar + for_ mb_ex MC.throwM + + return (AbstractSem{..}, cleanupSem) + +-- | Implement an abstract semaphore using a semaphore 'Jobserver' +-- which queries the system semaphore of the given name for resources. +runJSemAbstractSem :: SemaphoreName -- ^ the system semaphore to use + -> (AbstractSem -> IO a) -- ^ the operation to run + -- which requires a semaphore + -> IO a +runJSemAbstractSem sem action = MC.mask \ unmask -> do + (abs, cleanup) <- makeJobserver sem + r <- try $ unmask $ action abs + case r of + Left (e1 :: MC.SomeException) -> do + (_ :: Either MC.SomeException ()) <- MC.try cleanup + MC.throwM e1 + Right x -> cleanup $> x + +{- +Note [Architecture of the Job Server] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In `-jsem` mode, the amount of parallelism that GHC can use is controlled by a +system semaphore. We take resources from the semaphore when we need them, and +give them back if we don't have enough to do. + +A naive implementation would just take and release the semaphore around performing +the action, but this leads to two issues: + +* When taking a token in the semaphore, we must call `setNumCapabilities` in order + to adjust how many capabilities are available for parallel garbage collection. + This causes unnecessary synchronisations. +* We want to implement a debounce, so that whilst there is pending work in the + current process we prefer to keep hold of resources from the semaphore. + This reduces overall memory usage, as there are fewer live GHC processes at once. + +Therefore, the obtention of semaphore resources is separated away from the +request for the resource in the driver. + +A token from the semaphore is requested using `acquireJob`. This creates a pending +job, which is a MVar that can be filled in to signal that the requested token is ready. + +When the job is finished, the token is released by calling `releaseJob`, which just +increases the number of `free` jobs. If there are more pending jobs when the free count +is increased, the token is immediately reused (see `modifyJobResources`). + +The `jobServerLoop` interacts with the system semaphore: when there are pending +jobs, `acquireThread` blocks, waiting for a token from the semaphore. Once a +token is obtained, it increases the owned count. + +When GHC has free tokens (tokens from the semaphore that it is not using), +no pending jobs, and the debounce has expired, then `releaseThread` will +release tokens back to the global semaphore. + +`tryStopThread` attempts to kill threads which are waiting to acquire a resource +when we no longer need it. For example, consider that we attempt to acquire two +tokens, but the first job finishes before we acquire the second token. +This second token is no longer needed, so we should cancel the wait +(as it would not be used to do any work, and not be returned until the debounce). +We only need to kill `acquireJob`, because `releaseJob` never blocks. + +Note [Eventlog Messages for jsem] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +It can be tricky to verify that the work is shared adequately across different +processes. To help debug this, we output the values of `JobResource` to the +eventlog whenever the global state changes. There are some scripts which can be used +to analyse this output and report statistics about core saturation in the +GitHub repo (https://github.com/mpickering/ghc-jsem-analyse). + +-} ===================================== compiler/GHC/Driver/Pipeline/LogQueue.hs ===================================== @@ -100,10 +100,10 @@ dequeueLogQueueQueue (LogQueueQueue n lqq) = case IM.minViewWithKey lqq of Just ((k, v), lqq') | k == n -> Just (v, LogQueueQueue (n + 1) lqq') _ -> Nothing -logThread :: Int -> Int -> Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit +logThread :: Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit -> TVar LogQueueQueue -- Queue for logs -> IO (IO ()) -logThread _ _ logger stopped lqq_var = do +logThread logger stopped lqq_var = do finished_var <- newEmptyMVar _ <- forkIO $ print_logs *> putMVar finished_var () return (takeMVar finished_var) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -43,6 +43,7 @@ module GHC.Driver.Session ( needSourceNotes, OnOff(..), DynFlags(..), + ParMakeCount(..), outputFile, objectSuf, ways, FlagSpec(..), HasDynFlags(..), ContainsDynFlags(..), @@ -461,9 +462,13 @@ data DynFlags = DynFlags { ruleCheck :: Maybe String, strictnessBefore :: [Int], -- ^ Additional demand analysis - parMakeCount :: Maybe Int, -- ^ The number of modules to compile in parallel - -- in --make mode, where Nothing ==> compile as - -- many in parallel as there are CPUs. + parMakeCount :: Maybe ParMakeCount, + -- ^ The number of modules to compile in parallel + -- in --make mode, ignored with a warning if jobServerAuth is specified. + -- If unspecified, compile with a single job. + + jsemHandle :: Maybe FilePath, + -- ^ A handle to a parallelism semaphore enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? ghcHeapSize :: Maybe Int, -- ^ The heap size to set. @@ -783,6 +788,12 @@ instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where class ContainsDynFlags t where extractDynFlags :: t -> DynFlags +-- | The type for the -jN argument, specifying that -j on its own represents +-- using the number of machine processors. +data ParMakeCount + = ParMakeThisMany Int + | ParMakeNumProcessors + ----------------------------------------------------------------------------- -- Accessors from 'DynFlags' @@ -1146,7 +1157,8 @@ defaultDynFlags mySettings = historySize = 20, strictnessBefore = [], - parMakeCount = Just 1, + parMakeCount = Nothing, + jsemHandle = Nothing, enableTimeStats = False, ghcHeapSize = Nothing, @@ -2066,14 +2078,16 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "j" (OptIntSuffix (\n -> case n of Just n - | n > 0 -> upd (\d -> d { parMakeCount = Just n }) + | n > 0 -> upd (\d -> d { parMakeCount = Just (ParMakeThisMany n) }) | otherwise -> addErr "Syntax: -j[n] where n > 0" - Nothing -> upd (\d -> d { parMakeCount = Nothing }))) + Nothing -> upd (\d -> d { parMakeCount = Just ParMakeNumProcessors }))) -- When the number of parallel builds -- is omitted, it is the same -- as specifying that the number of -- parallel builds is equal to the -- result of getNumProcessors + , make_ord_flag defGhcFlag "jsem" $ hasArg $ \f d -> d { jsemHandle = Just f } + , make_ord_flag defFlag "instantiated-with" (sepArg setUnitInstantiations) , make_ord_flag defFlag "this-component-id" (sepArg setUnitInstanceOf) @@ -4886,6 +4900,11 @@ makeDynFlagsConsistent dflags , Nothing <- outputFile dflags = pgmError "--output must be specified when using --merge-objs" + | Just _ <- jsemHandle dflags + , Just _ <- parMakeCount dflags + = loop dflags{parMakeCount = Nothing} + "`-j` argument is ignored when using `-jsem`" + | otherwise = (dflags, []) where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") loop updated_dflags warning ===================================== compiler/ghc.cabal.in ===================================== @@ -85,6 +85,7 @@ Library hpc == 0.6.*, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, + semaphore-compat, stm, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, @@ -436,6 +437,7 @@ Library GHC.Driver.GenerateCgIPEStub GHC.Driver.Hooks GHC.Driver.LlvmConfigCache + GHC.Driver.MakeSem GHC.Driver.Main GHC.Driver.Make GHC.Driver.MakeFile ===================================== docs/users_guide/using.rst ===================================== @@ -751,6 +751,59 @@ search path (see :ref:`search-path`). number of processors. Note that compilation of a module may not begin until its dependencies have been built. + +GHC Jobserver Protocol +~~~~~~~~~~~~~~~~~~~~~~ + +This protocol allows +a server to dynamically invoke many instances of a client process, +while restricting all of those instances to use no more than capabilities. +This is achieved by coordination over a system semaphore (either a POSIX +semaphore in the case of Linux and Darwin, or a Win32 semaphore +in the case of Windows platforms). + +There are two kinds of participants in the GHC Jobserver protocol: + +- The *jobserver* creates a system semaphore with a certain number of + available tokens. + + Each time the jobserver wants to spawn a new jobclient subprocess, it **must** + first acquire a single token from the semaphore, before spawning + the subprocess. This token **must** be released once the subprocess terminates. + + Once work is finished, the jobserver **must** destroy the semaphore it created. + +- A *jobclient* is a subprocess spawned by the jobserver or another jobclient. + + Each jobclient starts with one available token (its *implicit token*, + which was acquired by the parent which spawned it), and can request more + tokens through the Jobserver Protocol by waiting on the semaphore. + + Each time a jobclient wants to spawn a new jobclient subprocess, it **must** + pass on a single token to the child jobclient. This token can either be the + jobclient's implicit token, or another token which the jobclient acquired + from the semaphore. + + Each jobclient **must** release exactly as many tokens as it has acquired from + the semaphore (this does not include the implicit tokens). + + GHC itself acts as a jobclient which can be enabled by using the flag ``-jsem``. + +.. ghc-flag:: -jsem + :shortdesc: When compiling with :ghc-flag:`--make`, coordinate with + other processes through the semaphore ⟨sem⟩ to compile + modules in parallel. + :type: dynamic + :category: misc + + Perform compilation in parallel when possible, coordinating with other + processes through the semaphore ⟨sem⟩. + Error if the semaphore doesn't exist. + + Use of ``-jsem`` will override use of :ghc-flag:``-j[⟨n⟩]``. + + + .. _multi-home-units: Multiple Home Units ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -39,7 +39,7 @@ ghcPackages = , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl - , parsec, pretty, process, rts, runGhc, stm, templateHaskell + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon @@ -55,7 +55,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, - parsec, pretty, primitive, process, rts, runGhc, stm, templateHaskell, + parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -110,6 +110,7 @@ process = lib "process" remoteIserv = util "remote-iserv" rts = top "rts" runGhc = util "runghc" +semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" terminfo = lib "terminfo" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -171,6 +171,7 @@ toolTargets = [ binary , templateHaskell , text , transformers + , semaphoreCompat , unlit -- # executable ] ++ if windowsHost then [ win32 ] else [ unix ] ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -95,6 +95,7 @@ stage0Packages = do , hpcBin , mtl , parsec + , semaphoreCompat , time , templateHaskell , text @@ -142,6 +143,7 @@ stage1Packages = do , integerGmp , pretty , rts + , semaphoreCompat , stm , unlit , xhtml ===================================== libraries/semaphore-compat ===================================== @@ -0,0 +1 @@ +Subproject commit 663ef75467995acf41c51d3e21d03347e85b844e ===================================== packages ===================================== @@ -65,5 +65,6 @@ libraries/Win32 - - https:/ libraries/xhtml - - https://github.com/haskell/xhtml.git libraries/exceptions - - https://github.com/ekmett/exceptions.git nofib nofib - - +libraries/semaphore-compat - - - libraries/stm - - ssh://git at github.com/haskell/stm.git . - ghc.git - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0db02e7c70ca6bfcb012e366e94a484935c775a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0db02e7c70ca6bfcb012e366e94a484935c775a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 17 11:00:42 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 17 Mar 2023 07:00:42 -0400 Subject: [Git][ghc/ghc][wip/T23070] 85 commits: Fix typo in docs referring to threadLabel Message-ID: <6414485a2b33a_20ac84207801c105055@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070 at Glasgow Haskell Compiler / GHC Commits: c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - ee035eea by Simon Peyton Jones at 2023-03-17T11:02:14+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - 23 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c3f9bd60b6e97f55880285ab1b7104138f61a1d...ee035eea1c4d1183f4279ac0faca0909d1faccf3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c3f9bd60b6e97f55880285ab1b7104138f61a1d...ee035eea1c4d1183f4279ac0faca0909d1faccf3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 17 13:36:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 17 Mar 2023 09:36:02 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Fix BCO creation setting caps when -j > -N Message-ID: <64146cc27cb97_20ac844aeca641624e0@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 2bfa89e0 by Torsten Schmits at 2023-03-17T09:35:48-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - 24 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Shape.hs - docs/users_guide/9.8.1-notes.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs - m4/fp_find_cxx_std_lib.m4 - testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr - testsuite/tests/backpack/should_fail/bkpfail01.stderr - testsuite/tests/backpack/should_fail/bkpfail05.stderr - testsuite/tests/backpack/should_fail/bkpfail09.stderr - testsuite/tests/backpack/should_fail/bkpfail16.stderr - testsuite/tests/backpack/should_fail/bkpfail20.stderr - testsuite/tests/backpack/should_fail/bkpfail21.stderr - testsuite/tests/backpack/should_fail/bkpfail35.stderr - testsuite/tests/backpack/should_fail/bkpfail37.stderr - testsuite/tests/backpack/should_fail/bkpfail38.stderr Changes: ===================================== compiler/GHC.hs ===================================== @@ -1304,8 +1304,7 @@ compileCore simplify fn = do else return $ Right mod_guts - Nothing -> panic "compileToCoreModule: target FilePath not found in\ - module dependency graph" + Nothing -> panic "compileToCoreModule: target FilePath not found in module dependency graph" where -- two versions, based on whether we simplify (thus run tidyProgram, -- which returns a (CgGuts, ModDetails) pair, or not (in which case -- we just have a ModGuts. ===================================== compiler/GHC/Driver/Config.hs ===================================== @@ -2,7 +2,6 @@ module GHC.Driver.Config ( initOptCoercionOpts , initSimpleOpts - , initBCOOpts , initEvalOpts ) where @@ -12,12 +11,8 @@ import GHC.Prelude import GHC.Driver.Session import GHC.Core.SimpleOpt import GHC.Core.Coercion.Opt -import GHC.Runtime.Interpreter (BCOOpts(..)) import GHCi.Message (EvalOpts(..)) -import GHC.Conc (getNumProcessors) -import Control.Monad.IO.Class - -- | Initialise coercion optimiser configuration from DynFlags initOptCoercionOpts :: DynFlags -> OptCoercionOpts initOptCoercionOpts dflags = OptCoercionOpts @@ -32,16 +27,6 @@ initSimpleOpts dflags = SimpleOpts , so_eta_red = gopt Opt_DoEtaReduction dflags } --- | Extract BCO options from DynFlags -initBCOOpts :: DynFlags -> IO BCOOpts -initBCOOpts dflags = do - -- Serializing ResolvedBCO is expensive, so if we're in parallel mode - -- (-j) parallelise the serialization. - n_jobs <- case parMakeCount dflags of - Nothing -> liftIO getNumProcessors - Just n -> return n - return $ BCOOpts n_jobs - -- | Extract GHCi options from DynFlags and step initEvalOpts :: DynFlags -> Bool -> EvalOpts initEvalOpts dflags step = ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -43,7 +43,6 @@ import GHC.Driver.Phases import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Ppr -import GHC.Driver.Config import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Finder @@ -598,8 +597,7 @@ loadExpr interp hsc_env span root_ul_bco = do nobreakarray = error "no break array" bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)] resolved <- linkBCO interp le bco_ix nobreakarray root_ul_bco - bco_opts <- initBCOOpts (hsc_dflags hsc_env) - [root_hvref] <- createBCOs interp bco_opts [resolved] + [root_hvref] <- createBCOs interp [resolved] fhv <- mkFinalizedHValue interp root_hvref return (pls, fhv) where @@ -946,8 +944,7 @@ loadDecls interp hsc_env span cbc at CompiledByteCode{..} = do , addr_env = plusNameEnv (addr_env le) bc_strs } -- Link the necessary packages and linkables - bco_opts <- initBCOOpts (hsc_dflags hsc_env) - new_bindings <- linkSomeBCOs bco_opts interp le2 [cbc] + new_bindings <- linkSomeBCOs interp le2 [cbc] nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings let ce2 = extendClosureEnv (closure_env le2) nms_fhvs !pls2 = pls { linker_env = le2 { closure_env = ce2 } } @@ -995,7 +992,6 @@ loadModuleLinkables interp hsc_env pls linkables let (objs, bcos) = partition isObjectLinkable (concatMap partitionLinkable linkables) - bco_opts <- initBCOOpts (hsc_dflags hsc_env) -- Load objects first; they can't depend on BCOs (pls1, ok_flag) <- loadObjects interp hsc_env pls objs @@ -1003,7 +999,7 @@ loadModuleLinkables interp hsc_env pls linkables if failed ok_flag then return (pls1, Failed) else do - pls2 <- dynLinkBCOs bco_opts interp pls1 bcos + pls2 <- dynLinkBCOs interp pls1 bcos return (pls2, Succeeded) @@ -1156,8 +1152,8 @@ rmDupLinkables already ls ********************************************************************* -} -dynLinkBCOs :: BCOOpts -> Interp -> LoaderState -> [Linkable] -> IO LoaderState -dynLinkBCOs bco_opts interp pls bcos = do +dynLinkBCOs :: Interp -> LoaderState -> [Linkable] -> IO LoaderState +dynLinkBCOs interp pls bcos = do let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos pls1 = pls { bcos_loaded = bcos_loaded' } @@ -1173,7 +1169,7 @@ dynLinkBCOs bco_opts interp pls bcos = do ae2 = foldr plusNameEnv (addr_env le1) (map bc_strs cbcs) le2 = le1 { itbl_env = ie2, addr_env = ae2 } - names_and_refs <- linkSomeBCOs bco_opts interp le2 cbcs + names_and_refs <- linkSomeBCOs interp le2 cbcs -- We only want to add the external ones to the ClosureEnv let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs @@ -1187,8 +1183,7 @@ dynLinkBCOs bco_opts interp pls bcos = do return $! pls1 { linker_env = le2 { closure_env = ce2 } } -- Link a bunch of BCOs and return references to their values -linkSomeBCOs :: BCOOpts - -> Interp +linkSomeBCOs :: Interp -> LinkerEnv -> [CompiledByteCode] -> IO [(Name,HValueRef)] @@ -1196,7 +1191,7 @@ linkSomeBCOs :: BCOOpts -- the incoming unlinked BCOs. Each gives the -- value of the corresponding unlinked BCO -linkSomeBCOs bco_opts interp le mods = foldr fun do_link mods [] +linkSomeBCOs interp le mods = foldr fun do_link mods [] where fun CompiledByteCode{..} inner accum = case bc_breaks of @@ -1211,7 +1206,7 @@ linkSomeBCOs bco_opts interp le mods = foldr fun do_link mods [] bco_ix = mkNameEnv (zip names [0..]) resolved <- sequence [ linkBCO interp le bco_ix breakarray bco | (breakarray, bco) <- flat ] - hvrefs <- createBCOs interp bco_opts resolved + hvrefs <- createBCOs interp resolved return (zip names hvrefs) -- | Useful to apply to the result of 'linkSomeBCOs' ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -11,7 +11,6 @@ module GHC.Runtime.Interpreter ( module GHC.Runtime.Interpreter.Types -- * High-level interface to the interpreter - , BCOOpts (..) , evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..) , resumeStmt , abandonStmt @@ -329,26 +328,11 @@ mkCostCentres :: Interp -> String -> [(String,String)] -> IO [RemotePtr CostCent mkCostCentres interp mod ccs = interpCmd interp (MkCostCentres mod ccs) -newtype BCOOpts = BCOOpts - { bco_n_jobs :: Int -- ^ Number of parallel jobs doing BCO serialization - } - -- | Create a set of BCOs that may be mutually recursive. -createBCOs :: Interp -> BCOOpts -> [ResolvedBCO] -> IO [HValueRef] -createBCOs interp opts rbcos = do - let n_jobs = bco_n_jobs opts - -- Serializing ResolvedBCO is expensive, so if we support doing it in parallel - if (n_jobs == 1) - then - interpCmd interp (CreateBCOs [runPut (put rbcos)]) - else do - old_caps <- getNumCapabilities - if old_caps == n_jobs - then void $ evaluate puts - else bracket_ (setNumCapabilities n_jobs) - (setNumCapabilities old_caps) - (void $ evaluate puts) - interpCmd interp (CreateBCOs puts) +createBCOs :: Interp -> [ResolvedBCO] -> IO [HValueRef] +createBCOs interp rbcos = do + -- Serializing ResolvedBCO is expensive, so we do it in parallel + interpCmd interp (CreateBCOs puts) where puts = parMap doChunk (chunkList 100 rbcos) ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -73,6 +73,7 @@ import GHC.Types.Unique.Set ( nonDetEltsUniqSet ) import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env +import GHC.Types.Fixity (defaultFixity) import GHC.Unit.State (pprWithUnitState, UnitState) import GHC.Unit.Module @@ -994,6 +995,32 @@ instance Diagnostic TcRnMessage where TcRnIllegalHsigDefaultMethods name meths -> mkSimpleDecorated $ text "Illegal default method" <> plural (NE.toList meths) <+> text "in class definition of" <+> ppr name <+> text "in hsig file" + TcRnHsigFixityMismatch real_thing real_fixity sig_fixity + -> + let ppr_fix f = ppr f <+> if f == defaultFixity then parens (text "default") else empty + in mkSimpleDecorated $ + vcat [ppr real_thing <+> text "has conflicting fixities in the module", + text "and its hsig file", + text "Main module:" <+> ppr_fix real_fixity, + text "Hsig file:" <+> ppr_fix sig_fixity] + TcRnHsigShapeMismatch (HsigShapeSortMismatch info1 info2) + -> mkSimpleDecorated $ + text "While merging export lists, could not combine" + <+> ppr info1 <+> text "with" <+> ppr info2 + <+> parens (text "one is a type, the other is a plain identifier") + TcRnHsigShapeMismatch (HsigShapeNotUnifiable name1 name2 notHere) + -> + let extra = if notHere + then text "Neither name variable originates from the current signature." + else empty + in mkSimpleDecorated $ + text "While merging export lists, could not unify" + <+> ppr name1 <+> text "with" <+> ppr name2 $$ extra + TcRnHsigMissingModuleExport occ unit_state impl_mod + -> mkSimpleDecorated $ + quotes (ppr occ) + <+> text "is exported by the hsig file, but not exported by the implementing module" + <+> quotes (pprWithUnitState unit_state $ ppr impl_mod) TcRnBadGenericMethod clas op -> mkSimpleDecorated $ hsep [text "Class", quotes (ppr clas), @@ -1726,6 +1753,12 @@ instance Diagnostic TcRnMessage where -> WarningWithFlag Opt_WarnWarningsDeprecations TcRnIllegalHsigDefaultMethods{} -> ErrorWithoutFlag + TcRnHsigFixityMismatch{} + -> ErrorWithoutFlag + TcRnHsigShapeMismatch{} + -> ErrorWithoutFlag + TcRnHsigMissingModuleExport{} + -> ErrorWithoutFlag TcRnBadGenericMethod{} -> ErrorWithoutFlag TcRnWarningMinimalDefIncomplete{} @@ -2196,6 +2229,12 @@ instance Diagnostic TcRnMessage where -> noHints TcRnIllegalHsigDefaultMethods{} -> noHints + TcRnHsigFixityMismatch{} + -> noHints + TcRnHsigShapeMismatch{} + -> noHints + TcRnHsigMissingModuleExport{} + -> noHints TcRnBadGenericMethod{} -> noHints TcRnWarningMinimalDefIncomplete{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -91,6 +91,7 @@ module GHC.Tc.Errors.Types ( , DeclSort(..) , NonStandardGuards(..) , RuleLhsErrReason(..) + , HsigShapeMismatchReason(..) ) where import GHC.Prelude @@ -105,6 +106,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , FixedRuntimeRepOrigin(..) ) import GHC.Tc.Types.Rank (Rank) import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType) +import GHC.Types.Avail (AvailInfo) import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) import GHC.Types.ForeignCall (CLabelString) @@ -2239,10 +2241,39 @@ data TcRnMessage where Test case: bkpfail40 -} - TcRnIllegalHsigDefaultMethods :: !Name -- ^ 'Name' of the class -> NE.NonEmpty (LHsBind GhcRn) -- ^ default methods -> TcRnMessage + + {-| TcRnHsigFixityMismatch is an error indicating that the fixity decl in a + Backpack signature file differs from the one in the source file for the same + operator. + + Test cases: + bkpfail37, bkpfail38 + -} + TcRnHsigFixityMismatch :: !TyThing -- ^ The operator whose fixity is defined + -> !Fixity -- ^ the fixity used in the source file + -> !Fixity -- ^ the fixity used in the signature + -> TcRnMessage + + {-| TcRnHsigShapeMismatch is a group of errors related to mismatches between + backpack signatures. + -} + TcRnHsigShapeMismatch :: !HsigShapeMismatchReason + -> TcRnMessage + + {-| TcRnHsigMissingModuleExport is an error indicating that a module doesn't + export a name exported by its signature. + + Test cases: + bkpfail01, bkpfail05, bkpfail09, bkpfail16, bkpfail35, bkpcabal06 + -} + TcRnHsigMissingModuleExport :: !OccName -- ^ The missing name + -> !UnitState -- ^ The module's unit state + -> !Module -- ^ The implementation module + -> TcRnMessage + {-| TcRnBadGenericMethod This test ensures that if you provide a "more specific" type signatures for the default method, you must also provide a binding. @@ -4419,3 +4450,24 @@ data NonStandardGuards where data RuleLhsErrReason = UnboundVariable RdrName NotInScopeError | IllegalExpression + +data HsigShapeMismatchReason = + {-| HsigShapeSortMismatch is an error indicating that an item in the + export list of a signature doesn't match the item of the same name in + another signature when merging the two – one is a type while the other is a + plain identifier. + + Test cases: + none + -} + HsigShapeSortMismatch !AvailInfo !AvailInfo + | + {-| HsigShapeNotUnifiable is an error indicating that a name in the + export list of a signature cannot be unified with a name of the same name in + another signature when merging the two. + + Test cases: + bkpfail20, bkpfail21 + -} + HsigShapeNotUnifiable !Name !Name !Bool + deriving (Generic) ===================================== compiler/GHC/Tc/Utils/Backpack.hs ===================================== @@ -88,21 +88,6 @@ import Data.List (find) import {-# SOURCE #-} GHC.Tc.Module - -fixityMisMatch :: TyThing -> Fixity -> Fixity -> TcRnMessage -fixityMisMatch real_thing real_fixity sig_fixity = - mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ppr real_thing <+> text "has conflicting fixities in the module", - text "and its hsig file", - text "Main module:" <+> ppr_fix real_fixity, - text "Hsig file:" <+> ppr_fix sig_fixity] - where - ppr_fix f = - ppr f <+> - (if f == defaultFixity - then parens (text "default") - else empty) - checkHsigDeclM :: ModIface -> TyThing -> TyThing -> TcRn () checkHsigDeclM sig_iface sig_thing real_thing = do let name = getName real_thing @@ -115,7 +100,7 @@ checkHsigDeclM sig_iface sig_thing real_thing = do Just f -> f when (real_fixity /= sig_fixity) $ addErrAt (nameSrcSpan name) - (fixityMisMatch real_thing real_fixity sig_fixity) + (TcRnHsigFixityMismatch real_thing real_fixity sig_fixity) -- | Given a 'ModDetails' of an instantiated signature (note that the -- 'ModDetails' must be knot-tied consistently with the actual implementation) @@ -677,7 +662,7 @@ mergeSignatures -- 3(d). Extend the name substitution (performing shaping) mb_r <- extend_ns nsubst as2 case mb_r of - Left err -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints err) + Left err -> failWithTc (TcRnHsigShapeMismatch err) Right nsubst' -> return (nsubst',oks',(imod, thinned_iface):ifaces) nsubst0 = mkNameShape (moduleName inner_mod) (mi_exports lcl_iface0) ok_to_use0 = mkOccSet (exportOccs (mi_exports lcl_iface0)) @@ -1004,10 +989,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do -- we need. (Notice we IGNORE the Modules in the AvailInfos.) forM_ (exportOccs (mi_exports isig_iface)) $ \occ -> case lookupGlobalRdrEnv impl_gr occ of - [] -> addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - quotes (ppr occ) - <+> text "is exported by the hsig file, but not exported by the implementing module" - <+> quotes (pprWithUnitState unit_state $ ppr impl_mod) + [] -> addErr $ TcRnHsigMissingModuleExport occ unit_state impl_mod _ -> return () failIfErrsM ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -471,6 +471,11 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnIllegalTypeOperatorDecl" = 50649 GhcDiagnosticCode "TcRnIllegalHsigDefaultMethods" = 93006 + GhcDiagnosticCode "TcRnHsigFixityMismatch" = 93007 + GhcDiagnosticCode "HsigShapeSortMismatch" = 93008 + GhcDiagnosticCode "HsigShapeNotUnifiable" = 93009 + GhcDiagnosticCode "TcRnHsigNoIface" = 93010 + GhcDiagnosticCode "TcRnHsigMissingModuleExport" = 93011 GhcDiagnosticCode "TcRnBadGenericMethod" = 59794 GhcDiagnosticCode "TcRnWarningMinimalDefIncomplete" = 13511 GhcDiagnosticCode "TcRnDefaultMethodForPragmaLacksBinding" = 28587 @@ -691,6 +696,7 @@ type family ConRecursInto con where ConRecursInto "TcRnPragmaWarning" = 'Just (WarningTxt GhcRn) ConRecursInto "TcRnNotInScope" = 'Just NotInScopeError ConRecursInto "TcRnIllegalNewtype" = 'Just IllegalNewtypeReason + ConRecursInto "TcRnHsigShapeMismatch" = 'Just HsigShapeMismatchReason -- -- TH errors ===================================== compiler/GHC/Types/Name/Shape.hs ===================================== @@ -25,8 +25,8 @@ import GHC.Types.Name.Env import GHC.Tc.Utils.Monad import GHC.Iface.Env +import GHC.Tc.Errors.Types -import GHC.Utils.Outputable import GHC.Utils.Panic.Plain import Control.Monad @@ -106,7 +106,7 @@ mkNameShape mod_name as = -- restricted notion of shaping than in Backpack'14: we do shaping -- *as* we do type-checking. Thus, once we shape a signature, its -- exports are *final* and we're not allowed to refine them further, -extendNameShape :: HscEnv -> NameShape -> [AvailInfo] -> IO (Either SDoc NameShape) +extendNameShape :: HscEnv -> NameShape -> [AvailInfo] -> IO (Either HsigShapeMismatchReason NameShape) extendNameShape hsc_env ns as = case uAvailInfos (ns_mod_name ns) (ns_exports ns) as of Left err -> return (Left err) @@ -224,7 +224,7 @@ mergeAvails as1 as2 = -- | Unify two lists of 'AvailInfo's, given an existing substitution @subst@, -- with only name holes from @flexi@ unifiable (all other name holes rigid.) -uAvailInfos :: ModuleName -> [AvailInfo] -> [AvailInfo] -> Either SDoc ShNameSubst +uAvailInfos :: ModuleName -> [AvailInfo] -> [AvailInfo] -> Either HsigShapeMismatchReason ShNameSubst uAvailInfos flexi as1 as2 = -- pprTrace "uAvailInfos" (ppr as1 $$ ppr as2) $ let mkOE as = listToUFM $ do a <- as n <- availNames a @@ -236,34 +236,27 @@ uAvailInfos flexi as1 as2 = -- pprTrace "uAvailInfos" (ppr as1 $$ ppr as2) $ -- | Unify two 'AvailInfo's, given an existing substitution @subst@, -- with only name holes from @flexi@ unifiable (all other name holes rigid.) uAvailInfo :: ModuleName -> ShNameSubst -> AvailInfo -> AvailInfo - -> Either SDoc ShNameSubst + -> Either HsigShapeMismatchReason ShNameSubst uAvailInfo flexi subst (Avail (NormalGreName n1)) (Avail (NormalGreName n2)) = uName flexi subst n1 n2 uAvailInfo flexi subst (AvailTC n1 _) (AvailTC n2 _) = uName flexi subst n1 n2 -uAvailInfo _ _ a1 a2 = Left $ text "While merging export lists, could not combine" - <+> ppr a1 <+> text "with" <+> ppr a2 - <+> parens (text "one is a type, the other is a plain identifier") +uAvailInfo _ _ a1 a2 = Left $ HsigShapeSortMismatch a1 a2 -- | Unify two 'Name's, given an existing substitution @subst@, -- with only name holes from @flexi@ unifiable (all other name holes rigid.) -uName :: ModuleName -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst +uName :: ModuleName -> ShNameSubst -> Name -> Name -> Either HsigShapeMismatchReason ShNameSubst uName flexi subst n1 n2 | n1 == n2 = Right subst | isFlexi n1 = uHoleName flexi subst n1 n2 | isFlexi n2 = uHoleName flexi subst n2 n1 - | otherwise = Left (text "While merging export lists, could not unify" - <+> ppr n1 <+> text "with" <+> ppr n2 $$ extra) + | otherwise = Left (HsigShapeNotUnifiable n1 n2 (isHoleName n1 || isHoleName n2)) where isFlexi n = isHoleName n && moduleName (nameModule n) == flexi - extra | isHoleName n1 || isHoleName n2 - = text "Neither name variable originates from the current signature." - | otherwise - = empty -- | Unify a name @h@ which 'isHoleName' with another name, given an existing -- substitution @subst@, with only name holes from @flexi@ unifiable (all -- other name holes rigid.) uHoleName :: ModuleName -> ShNameSubst -> Name {- hole name -} -> Name - -> Either SDoc ShNameSubst + -> Either HsigShapeMismatchReason ShNameSubst uHoleName flexi subst h n = assert (isHoleName h) $ case lookupNameEnv subst h of ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -32,6 +32,9 @@ Compiler the specification described in the documentation of the `INCOHERENT` pragma. See GHC ticket #22448 for further details. +- Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``. + See GHC ticket #23049. + GHCi ~~~~ ===================================== ghc/GHCi/UI.hs ===================================== @@ -2346,8 +2346,12 @@ typeAtCmd str = runExceptGhciMonad $ do (span',sample) <- exceptT $ parseSpanArg str infos <- lift $ mod_infos <$> getGHCiState (info, ty) <- findType infos span' sample - lift $ printForUserModInfo (modinfoInfo info) - (sep [text sample,nest 2 (dcolon <+> ppr ty)]) + let mb_rdr_env = case modinfoRdrEnv info of + Strict.Just rdrs -> Just rdrs + Strict.Nothing -> Nothing + lift $ printForUserGlobalRdrEnv + mb_rdr_env + (sep [text sample,nest 2 (dcolon <+> ppr ty)]) ----------------------------------------------------------------------------- -- | @:uses@ command ===================================== ghc/GHCi/UI/Info.hs ===================================== @@ -42,6 +42,7 @@ import GHC.Driver.Monad import GHC.Driver.Env import GHC.Driver.Ppr import GHC.Types.Name +import GHC.Types.Name.Reader import GHC.Types.Name.Set import GHC.Utils.Outputable import GHC.Types.SrcLoc @@ -58,9 +59,8 @@ data ModInfo = ModInfo -- ^ Generated set of information about all spans in the -- module that correspond to some kind of identifier for -- which there will be type info and/or location info. - , modinfoInfo :: !ModuleInfo - -- ^ Again, useful from GHC for accessing information - -- (exports, instances, scope) from a module. + , modinfoRdrEnv :: !(Strict.Maybe GlobalRdrEnv) + -- ^ What's in scope in the module. , modinfoLastUpdate :: !UTCTime -- ^ The timestamp of the file used to generate this record. } @@ -174,9 +174,9 @@ findName infos span0 mi string = UnhelpfulSpan {} -> tryExternalModuleResolution RealSrcSpan {} -> return (getName name) where + rdrs = modInfo_rdrs mi tryExternalModuleResolution = - case find (matchName $ mkFastString string) - (fromMaybe [] (modInfoTopLevelScope (modinfoInfo mi))) of + case find (matchName $ mkFastString string) rdrs of Nothing -> throwE "Couldn't resolve to any modules." Just imported -> resolveNameFromModule infos imported @@ -198,8 +198,10 @@ resolveNameFromModule infos name = do ppr modL)) return $ M.lookup (moduleName modL) infos + let all_names = modInfo_rdrs info + maybe (throwE "No matching export in any local modules.") return $ - find (matchName name) (modInfoExports (modinfoInfo info)) + find (matchName name) all_names where matchName :: Name -> Name -> Bool matchName x y = occNameFS (getOccName x) == @@ -311,9 +313,25 @@ getModInfo name = do p <- parseModule m typechecked <- typecheckModule p let allTypes = processAllTypeCheckedModule typechecked - let i = tm_checked_module_info typechecked + module_info = tm_checked_module_info typechecked + !rdr_env = case modInfoRdrEnv module_info of + Just rdrs -> Strict.Just rdrs + Nothing -> Strict.Nothing ts <- liftIO $ getModificationTime $ srcFilePath m - return (ModInfo m allTypes i ts) + return $ + ModInfo + { modinfoSummary = m + , modinfoSpans = allTypes + , modinfoRdrEnv = rdr_env + , modinfoLastUpdate = ts + } + +-- | Get the 'Name's from the 'GlobalRdrEnv' of the 'ModInfo', if any. +modInfo_rdrs :: ModInfo -> [Name] +modInfo_rdrs mi = + case modinfoRdrEnv mi of + Strict.Nothing -> [] + Strict.Just env -> map greMangledName $ globalRdrEnvElts env -- | Get ALL source spans in the module. processAllTypeCheckedModule :: TypecheckedModule -> [SpanInfo] ===================================== ghc/GHCi/UI/Monad.hs ===================================== @@ -24,7 +24,8 @@ module GHCi.UI.Monad ( runStmt, runDecls, runDecls', resume, recordBreak, revertCAFs, ActionStats(..), runAndPrintStats, runWithStats, printStats, - printForUserNeverQualify, printForUserModInfo, + printForUserNeverQualify, + printForUserModInfo, printForUserGlobalRdrEnv, printForUser, printForUserPartWay, prettyLocations, compileGHCiExpr, @@ -41,6 +42,7 @@ import GHC.Driver.Monad hiding (liftIO) import GHC.Utils.Outputable import qualified GHC.Driver.Ppr as Ppr import GHC.Types.Name.Occurrence +import GHC.Types.Name.Reader import GHC.Driver.Session import GHC.Data.FastString import GHC.Driver.Env @@ -49,6 +51,7 @@ import GHC.Types.SafeHaskell import GHC.Driver.Make (ModIfaceCache(..)) import GHC.Unit import GHC.Types.Name.Reader as RdrName (mkOrig) +import qualified GHC.Types.Name.Ppr as Ppr (mkNamePprCtx ) import GHC.Builtin.Names (gHC_GHCI_HELPERS) import GHC.Runtime.Interpreter import GHC.Runtime.Context @@ -362,11 +365,20 @@ printForUserNeverQualify doc = do liftIO $ Ppr.printForUser dflags stdout neverQualify AllTheWay doc printForUserModInfo :: GhcMonad m => GHC.ModuleInfo -> SDoc -> m () -printForUserModInfo info doc = do +printForUserModInfo info = printForUserGlobalRdrEnv (GHC.modInfoRdrEnv info) + +printForUserGlobalRdrEnv :: GhcMonad m => Maybe GlobalRdrEnv -> SDoc -> m () +printForUserGlobalRdrEnv mb_rdr_env doc = do dflags <- GHC.getInteractiveDynFlags - m_name_ppr_ctx <- GHC.mkNamePprCtxForModule info - name_ppr_ctx <- maybe GHC.getNamePprCtx return m_name_ppr_ctx + name_ppr_ctx <- mkNamePprCtxFromGlobalRdrEnv dflags mb_rdr_env liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc + where + mkNamePprCtxFromGlobalRdrEnv _ Nothing = GHC.getNamePprCtx + mkNamePprCtxFromGlobalRdrEnv dflags (Just rdr_env) = + withSession $ \ hsc_env -> + let unit_env = hsc_unit_env hsc_env + ptc = initPromotionTickContext dflags + in return $ Ppr.mkNamePprCtx ptc unit_env rdr_env printForUser :: GhcMonad m => SDoc -> m () printForUser doc = do ===================================== m4/fp_find_cxx_std_lib.m4 ===================================== @@ -4,6 +4,14 @@ # Identify which C++ standard library implementation the C++ toolchain links # against. AC_DEFUN([FP_FIND_CXX_STD_LIB],[ + # Annoyingly, Darwin's includes and APFS is + # case-insensitive. Consequently, it will end up #including the + # VERSION file generated by the configure script on the second + # and subsequent runs of the configure script. + # See #23116. + mkdir -p actest.tmp + cd actest.tmp + # If this is non-empty then assume that the user has specified these # manually. if test -z "$CXX_STD_LIB_LIBS"; then @@ -87,6 +95,9 @@ EOF rm -f actest.cpp actest.o actest fi + cd .. + rm -R actest.tmp + AC_SUBST([CXX_STD_LIB_LIBS]) AC_SUBST([CXX_STD_LIB_LIB_DIRS]) AC_SUBST([CXX_STD_LIB_DYN_LIB_DIRS]) ===================================== testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr ===================================== @@ -1,4 +1,4 @@ -sig/P.hsig:1:1: error: +sig/P.hsig:1:1: error: [GHC-93011] • ‘p’ is exported by the hsig file, but not exported by the implementing module ‘bkpcabal06-0.1.0.0:impl:P’ • while checking that bkpcabal06-0.1.0.0:impl:P implements signature P in bkpcabal06-0.1.0.0:sig[P=bkpcabal06-0.1.0.0:impl:P] ===================================== testsuite/tests/backpack/should_fail/bkpfail01.stderr ===================================== @@ -10,10 +10,10 @@ Instantiating p[H=q:H] [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) -bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: +bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: [GHC-93011] • ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’ • while checking that q:H implements signature H in p[H=q:H] -bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: +bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: [GHC-93011] • ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’ • while checking that q:H implements signature H in p[H=q:H] ===================================== testsuite/tests/backpack/should_fail/bkpfail05.stderr ===================================== @@ -18,6 +18,6 @@ Instantiating h[H=h-impl:H] [1 of 1] Compiling H[sig] ( h/H.hsig, bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/H.o ) -bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/../H.hi:1:1: error: +bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/../H.hi:1:1: error: [GHC-93011] • ‘T1’ is exported by the hsig file, but not exported by the implementing module ‘h-impl:H’ • while checking that h-impl:H implements signature H in h[H=h-impl:H] ===================================== testsuite/tests/backpack/should_fail/bkpfail09.stderr ===================================== @@ -8,10 +8,10 @@ [1 of 3] Compiling H2[sig] ( r/H2.hsig, nothing ) [2 of 3] Instantiating p -Command line argument: -unit-id p[H=H]:0:0: error: +Command line argument: -unit-id p[H=H]:0:0: error: [GHC-93011] • ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’ • while checking that q:H implements signature H in p[H=q:H] -Command line argument: -unit-id p[H=H]:0:0: error: +Command line argument: -unit-id p[H=H]:0:0: error: [GHC-93011] • ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’ • while checking that q:H implements signature H in p[H=q:H] ===================================== testsuite/tests/backpack/should_fail/bkpfail16.stderr ===================================== @@ -6,6 +6,6 @@ Instantiating p[ShouldFail=base-4.13.0.0:Data.Bool] [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/ShouldFail.o ) -bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/../ShouldFail.hi:1:1: error: +bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/../ShouldFail.hi:1:1: error: [GHC-93011] • ‘Booly’ is exported by the hsig file, but not exported by the implementing module ‘Data.Bool’ • while checking that Data.Bool implements signature ShouldFail in p[ShouldFail=Data.Bool] ===================================== testsuite/tests/backpack/should_fail/bkpfail20.stderr ===================================== @@ -5,7 +5,7 @@ [3 of 3] Processing r [1 of 3] Compiling B[sig] ( r/B.hsig, nothing ) -bkpfail20.bkp:1:1: error: +bkpfail20.bkp:1:1: error: [GHC-93009] • While merging export lists, could not unify Data.STRef.Lazy.newSTRef with GHC.STRef.newSTRef • while merging the signatures from: • p[A=]:A ===================================== testsuite/tests/backpack/should_fail/bkpfail21.stderr ===================================== @@ -9,7 +9,7 @@ [2 of 5] Compiling H1[sig] ( r/H1.hsig, nothing ) [3 of 5] Compiling H3[sig] ( r/H3.hsig, nothing ) -bkpfail21.bkp:1:1: error: +bkpfail21.bkp:1:1: error: [GHC-93009] • While merging export lists, could not unify {H1.T} with {H2.T} Neither name variable originates from the current signature. • while merging the signatures from: ===================================== testsuite/tests/backpack/should_fail/bkpfail35.stderr ===================================== @@ -13,6 +13,6 @@ Instantiating q[A=aimpl:A] [1 of 1] Compiling A[sig] ( q/A.hsig, bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/A.o ) -bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/../A.hi:1:1: error: +bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/../A.hi:1:1: error: [GHC-93011] • ‘y’ is exported by the hsig file, but not exported by the implementing module ‘aimpl:A’ • while checking that aimpl:A implements signature A in q[A=aimpl:A] ===================================== testsuite/tests/backpack/should_fail/bkpfail37.stderr ===================================== @@ -9,7 +9,7 @@ Instantiating p[A=q:A] [1 of 1] Compiling A[sig] ( p/A.hsig, bkpfail37.out/p/p-HVmFlcYSefiK5n1aDP1v7x/A.o ) -bkpfail37.bkp:9:9: error: +bkpfail37.bkp:9:9: error: [GHC-93007] • Identifier ‘op’ has conflicting fixities in the module and its hsig file Main module: infixr 4 ===================================== testsuite/tests/backpack/should_fail/bkpfail38.stderr ===================================== @@ -5,7 +5,7 @@ [3 of 3] Processing r [1 of 3] Compiling A[sig] ( r/A.hsig, nothing ) -bkpfail38.bkp:8:9: error: +bkpfail38.bkp:8:9: error: [GHC-93007] • Identifier ‘op’ has conflicting fixities in the module and its hsig file Main module: infixr 4 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/148d155cf7da201cbec96be9b5686f8441fd8492...2bfa89e054ce4297de2fba1023545c9238a2d46f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/148d155cf7da201cbec96be9b5686f8441fd8492...2bfa89e054ce4297de2fba1023545c9238a2d46f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 17 14:58:50 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 17 Mar 2023 10:58:50 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 2 commits: compiler: Implement atomicSwapIORef with xchg Message-ID: <6414802a9f428_20ac8461517f01943d3@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: 9075bd09 by Ben Gamari at 2023-03-17T10:58:45-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - 5b59504e by Ben Gamari at 2023-03-17T10:58:45-04:00 testsuite: Add test for atomicSwapIORef# - - - - - 8 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/GHC/IORef.hs - + libraries/base/tests/AtomicSwapIORef.hs - libraries/base/tests/all.T - rts/PrimOps.cmm - rts/include/Cmm.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2464,6 +2464,13 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp + MutVar# s v -> v -> State# s -> (# State# s, v #) + {Atomically exchange the value of a 'MutVar#'.} + with + out_of_line = True + has_side_effects = True + -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1559,6 +1559,7 @@ emitPrimOp cfg primop = ResizeMutableByteArrayOp_Char -> alwaysExternal ShrinkSmallMutableArrayOp_Char -> alwaysExternal NewMutVarOp -> alwaysExternal + AtomicSwapMutVarOp -> alwaysExternal AtomicModifyMutVar2Op -> alwaysExternal AtomicModifyMutVar_Op -> alwaysExternal CasMutVarOp -> alwaysExternal ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -859,6 +859,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -28,6 +28,7 @@ module GHC.IORef ( import GHC.Base import GHC.STRef import GHC.IO +import GHC.Prim (atomicSwapMutVar#) -- --------------------------------------------------------------------------- -- IORefs @@ -127,10 +128,9 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a --- Bad implementation! This will be a primop shortly. atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicModifyMutVar2# ref (\_old -> Box new) s of - (# s', old, Box _new #) -> (# s', old #) + case atomicSwapMutVar# ref new s of + (# s', old #) -> (# s', old #) data Box a = Box a ===================================== libraries/base/tests/AtomicSwapIORef.hs ===================================== @@ -0,0 +1,7 @@ +import Data.IORef + +main :: IO () +main = do + r <- newIORef 42 :: IO Int + atomicSwapIORef r 43 + readIORef r >>= print ===================================== libraries/base/tests/all.T ===================================== @@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('AtomicSwapIORef', normal, compile_and_run, ['']) ===================================== rts/PrimOps.cmm ===================================== @@ -689,6 +689,14 @@ stg_newMutVarzh ( gcptr init ) return (mv); } +stg_swapMutVarzh ( gcptr mv, gcptr old ) + /* MutVar# s a -> a -> State# s -> (# State#, a #) */ +{ + W_ new; + (new) = prim %xchgW(mv+OFFSET_StgMutVar_var, old); + return (new); +} + // RRN: To support the "ticketed" approach, we return the NEW rather // than old value if the CAS is successful. This is received in an // opaque form in the Haskell code, preventing the compiler from ===================================== rts/include/Cmm.h ===================================== @@ -193,8 +193,10 @@ #if SIZEOF_W == 4 #define cmpxchgW cmpxchg32 +#define xchgW xchg32 #elif SIZEOF_W == 8 #define cmpxchgW cmpxchg64 +#define xchgW xchg64 #endif /* ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80c09bf88a47ef9b14d094d6d723b0b1c03abaf6...5b59504e25aa116639c467a391ec4e1d6149388c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80c09bf88a47ef9b14d094d6d723b0b1c03abaf6...5b59504e25aa116639c467a391ec4e1d6149388c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 17 15:46:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 17 Mar 2023 11:46:58 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-base Message-ID: <64148b722dd26_20ac846e0610819968c@gitlab.mail> Ben Gamari pushed new branch wip/ghc-base at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-base You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 17 18:00:07 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 17 Mar 2023 14:00:07 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Respond to Richard's review Message-ID: <6414aaa76adbd_20ac84919eb7421154a@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 5e122c94 by Simon Peyton Jones at 2023-03-17T18:01:10+00:00 Respond to Richard's review - - - - - 8 changed files: - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/polykinds/T14939.hs Changes: ===================================== compiler/GHC/Data/Bag.hs ===================================== @@ -19,7 +19,7 @@ module GHC.Data.Bag ( isEmptyBag, isSingletonBag, consBag, snocBag, anyBag, allBag, listToBag, nonEmptyToBag, bagToList, headMaybe, mapAccumBagL, concatMapBag, concatMapBagPair, mapMaybeBag, unzipBag, - mapBagM, mapBagM_, + mapBagM, mapBagM_, lookupBag, flatMapBagM, flatMapBagPairM, mapAndUnzipBagM, mapAccumBagLM, anyBagM, filterBagM @@ -38,6 +38,7 @@ import Data.List ( partition, mapAccumL ) import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.List.NonEmpty as NE import qualified Data.Semigroup ( (<>) ) +import Control.Applicative( Alternative( (<|>) ) ) infixr 3 `consBag` infixl 3 `snocBag` @@ -115,6 +116,16 @@ filterBagM pred (ListBag vs) = do sat <- filterM pred (toList vs) return (listToBag sat) +lookupBag :: Eq a => a -> Bag (a,b) -> Maybe b +lookupBag _ EmptyBag = Nothing +lookupBag k (UnitBag kv) = lookup_one k kv +lookupBag k (TwoBags b1 b2) = lookupBag k b1 <|> lookupBag k b2 +lookupBag k (ListBag xs) = foldr ((<|>) . lookup_one k) Nothing xs + +lookup_one :: Eq a => a -> (a,b) -> Maybe b +lookup_one k (k',v) | k==k' = Just v + | otherwise = Nothing + allBag :: (a -> Bool) -> Bag a -> Bool allBag _ EmptyBag = True allBag p (UnitBag v) = p v ===================================== compiler/GHC/Data/Maybe.hs ===================================== @@ -35,6 +35,7 @@ import Data.Maybe import Data.Foldable ( foldlM, for_ ) import GHC.Utils.Misc (HasCallStack) import Data.List.NonEmpty ( NonEmpty ) +import Control.Applicative( Alternative( (<|>) ) ) infixr 4 `orElse` @@ -47,7 +48,7 @@ infixr 4 `orElse` -} firstJust :: Maybe a -> Maybe a -> Maybe a -firstJust a b = firstJusts [a, b] +firstJust = (<|>) -- | Takes a list of @Maybes@ and returns the first @Just@ if there is one, or -- @Nothing@ otherwise. ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1641,9 +1641,8 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco What if one side is a TyVarLHS and the other is a TyFamLHS, (a ~ F tys)? Which to put on the left? Answer: * Put the tyvar on the left, (a ~ F tys) as this may be our only shot to unify. -* But if we fail to unify and end up in cantMakeCanonical, - then flip back to (F tys ~ a) because it's generally better - to rewrite away function calls. This makes types smaller. +* But if we fail to unify then flip back to (F tys ~ a) because it's generally + better to rewrite away function calls. It's important to flip back. Consider [W] F alpha ~ alpha @@ -1712,9 +1711,11 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs , NomEq <- eq_rel -- See Note [Do not unify representational equalities] , TyVarLHS tv <- lhs = do { given_eq_lvl <- getInnermostGivenEqLevel - ; if not (touchabilityTest given_eq_lvl tv rhs) + ; if not (touchabilityAndShapeTest given_eq_lvl tv rhs) then if | Just can_rhs <- canTyFamEqLHS_maybe rhs -> swapAndFinish ev eq_rel swapped tv can_rhs + -- See Note [Orienting TyVarLHS/TyFamLHS] + | otherwise -> canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs else @@ -1725,14 +1726,25 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs PuFail reason | Just can_rhs <- canTyFamEqLHS_maybe rhs -> swapAndFinish ev eq_rel swapped tv can_rhs + -- See Note [Orienting TyVarLHS/TyFamLHS] + + -- If we have [W] alpha[2] ~ Maybe b[3] + -- we can't unify (skolem-escape); but it /is/ canonical, + -- and hence we /can/ use it for rewriting + | reason `cterHasOnlyProblem` cteSkolemEscape + -> canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs + | otherwise -> tryIrredInstead reason ev eq_rel swapped lhs rhs ; PuOK rhs_redn _ -> -- Success: we can solve by unification - do { new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped - (mkReflRedn Nominal (mkTyVarTy tv)) rhs_redn + do { -- Comment needed! + new_ev <- if isReflCo (reductionCoercion rhs_redn) + then return ev + else rewriteEqEvidence emptyRewriterSet ev swapped + (mkReflRedn Nominal (mkTyVarTy tv)) rhs_redn ; let tv_ty = mkTyVarTy tv final_rhs = reductionReducedType rhs_redn @@ -1769,7 +1781,6 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs --------------------------- -- Unification is off the table --- Here we never have TyVarLHS ~ TyFamLHS (it is always the other way) canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs = do { -- Do checkTypeEq to guarantee (TyEq:OC), (TyEq:F) -- Must do the occurs check even on tyvar/tyvar equalities, @@ -1791,8 +1802,9 @@ canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs swapAndFinish :: CtEvidence -> EqRel -> SwapFlag -> TcTyVar -> CanEqLHS -- a ~ F tys -> TcS (StopOrContinue Ct) --- We have an equality a ~ F tys, and want to flip it to --- (F tys ~ a), whereupon it is canonical +-- We have an equality alpha ~ F tys, that we can't unify e.g because 'tys' +-- mentions alpha, it would not be a canonical constraint as-is. +-- We want to flip it to (F tys ~ a), whereupon it is canonical swapAndFinish ev eq_rel swapped lhs_tv can_rhs = do { let lhs_ty = mkTyVarTy lhs_tv ; new_ev <- rewriteEqEvidence emptyRewriterSet ev (flipSwap swapped) @@ -1807,7 +1819,7 @@ swapAndFinish ev eq_rel swapped lhs_tv can_rhs tryIrredInstead :: CheckTyEqResult -> CtEvidence -> EqRel -> SwapFlag -> CanEqLHS -> TcType -> TcS (StopOrContinue Ct) -- We have a non-canonical equality --- We still swap it 'swapped' sayso, so that it is oriented +-- We still swap it if 'swapped' says so, so that it is oriented -- in the direction that the error message reporting machinery -- expects it; e.g. (m ~ t m) rather than (t m ~ m) -- This is not very important, and only affects error reporting. @@ -1863,8 +1875,9 @@ Wrinkles: and unifying alpha effectively promotes this wanted to a given. Doing so means we lose track of the rewriter set associated with the wanted. - In short: we must not have a co_hole in a Given, and unification - effectively makes a Given + Another way to say it: we must not have a co_hole in a Given, and + unification effectively makes a Given. (This is not very well motivated; + may need to dig deeper if anything goes wrong.) On the other hand, w is perfectly suitable for rewriting, because of the way we carefully track rewriter sets. @@ -2002,7 +2015,6 @@ The details depend on whether we're working with a Given or a Wanted. Given ----- - We emit a new Given, [G] F a ~ cbv, equating the type family application to our new cbv. Note its orientation: The type family ends up on the left; see commentary on canEqTyVarFunEq, which decides how to orient such cases. No @@ -2059,19 +2071,14 @@ and we turn this into where cbv1 and cbv2 are fresh TauTvs. Why TauTvs? See [Why TauTvs] below. Critically, we emit the two new constraints (the last two above) -directly instead of calling unifyWanted. (Otherwise, we'd end up unifying cbv1 -and cbv2 immediately, achieving nothing.) -Next, we unify alpha := cbv1 -> cbv2, having eliminated the occurs check. This -unification -- which must be the next step after breaking the cycles -- -happens in the course of normal behavior of top-level -interactions, later in the solver pipeline. We know this unification will -indeed happen because breakTyEqCycle_maybe, which decides whether to apply -this logic, checks to ensure unification will succeed in its final_check. -(In particular, the LHS must be a touchable tyvar, never a type family. We don't -yet have an example of where this logic is needed with a type family, and it's -unclear how to handle this case, so we're skipping for now.) Now, we're -here (including further context from our original example, from the top of the -Note): +directly instead of calling unifyWanted. (Otherwise, we'd end up +unifying cbv1 and cbv2 immediately, achieving nothing.) Next, we +unify alpha := cbv1 -> cbv2, having eliminated the occurs check. This +unification happens immediately following a successful call to +checkTouchableTyVarEq, in canEqCanLHSFinish_try_unification. + +Now, we're here (including further context from our original example, +from the top of the Note): instance C (a -> b) [W] Arg (cbv1 -> cbv2) ~ cbv1 ===================================== compiler/GHC/Tc/Solver/InertSet.hs ===================================== @@ -237,13 +237,15 @@ instance Outputable WorkList where * * ********************************************************************* -} -type CycleBreakerVarStack = NonEmpty [(TcTyVar, TcType)] +type CycleBreakerVarStack = NonEmpty (Bag (TcTyVar, TcType)) -- ^ a stack of (CycleBreakerTv, original family applications) lists -- first element in the stack corresponds to current implication; -- later elements correspond to outer implications -- used to undo the cycle-breaking needed to handle -- Note [Type equality cycles] in GHC.Tc.Solver.Canonical -- Why store the outer implications? For the use in mightEqualLater (only) + -- + -- Why NonEmpty? So there is always a top element to add to data InertSet = IS { inert_cans :: InertCans @@ -291,7 +293,7 @@ emptyInertCans emptyInert :: InertSet emptyInert = IS { inert_cans = emptyInertCans - , inert_cycle_breakers = [] :| [] + , inert_cycle_breakers = emptyBag :| [] , inert_famapp_cache = emptyFunEqs , inert_solved_dicts = emptyDictMap } @@ -722,7 +724,7 @@ applying S(f,_) to t. ----------------------------------------------------------------------------- Our main invariant: - the CEqCans in inert_eqs should be a terminating generalised substitution + the EqCts in inert_eqs should be a terminating generalised substitution ----------------------------------------------------------------------------- Note that termination is not the same as idempotence. To apply S to a @@ -814,7 +816,7 @@ Main Theorem [Stability under extension] (T3) lhs not in t -- No occurs check in the work item -- If lhs is a type family application, we require only that -- lhs is not *rewritable* in t. See Note [Rewritable] and - -- Note [CEqCan occurs check] in GHC.Tc.Types.Constraint. + -- Note [EqCt occurs check] in GHC.Tc.Types.Constraint. AND, for every (lhs1 -fs-> s) in S: (K0) not (fw >= fs) @@ -849,7 +851,7 @@ The idea is that * T3 is guaranteed by an occurs-check on the work item. This is done during canonicalisation, in checkTypeEq; invariant - (TyEq:OC) of CEqCan. See also Note [CEqCan occurs check] in GHC.Tc.Types.Constraint. + (TyEq:OC) of CEqCan. See also Note [EqCt occurs check] in GHC.Tc.Types.Constraint. * (K1-3) are the "kick-out" criteria. (As stated, they are really the "keep" criteria.) If the current inert S contains a triple that does @@ -1811,7 +1813,7 @@ lookupCycleBreakerVar cbv (IS { inert_cycle_breakers = cbvs_stack }) -- to avoid #20231. This function (and its one usage site) is the only reason -- that we store a stack instead of just the top environment. | Just tyfam_app <- assert (isCycleBreakerTyVar cbv) $ - firstJusts (NE.map (lookup cbv) cbvs_stack) + firstJusts (NE.map (lookupBag cbv) cbvs_stack) = tyfam_app | otherwise = pprPanic "lookupCycleBreakerVar found an unbound cycle breaker" (ppr cbv $$ ppr cbvs_stack) @@ -1819,16 +1821,16 @@ lookupCycleBreakerVar cbv (IS { inert_cycle_breakers = cbvs_stack }) -- | Push a fresh environment onto the cycle-breaker var stack. Useful -- when entering a nested implication. pushCycleBreakerVarStack :: CycleBreakerVarStack -> CycleBreakerVarStack -pushCycleBreakerVarStack = ([] <|) +pushCycleBreakerVarStack = (emptyBag <|) -- | Add a new cycle-breaker binding to the top environment on the stack. -addCycleBreakerBindings :: [(TcTyVar, Type)] -- ^ (cbv,expansion) pairs +addCycleBreakerBindings :: Bag (TcTyVar, Type) -- ^ (cbv,expansion) pairs -> InertSet -> InertSet addCycleBreakerBindings prs ics = assertPpr (all (isCycleBreakerTyVar . fst) prs) (ppr prs) $ ics { inert_cycle_breakers = add_to (inert_cycle_breakers ics) } where - add_to (top_env :| rest_envs) = (prs ++ top_env) :| rest_envs + add_to (top_env :| rest_envs) = (prs `unionBags` top_env) :| rest_envs -- | Perform a monadic operation on all pairs in the top environment -- in the stack. ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -48,7 +48,7 @@ module GHC.Tc.Solver.Monad ( newWanted, newWantedNC, newWantedEvVarNC, newBoundEvVarId, - unifyTyVar, reportUnifications, touchabilityTest, + unifyTyVar, reportUnifications, touchabilityAndShapeTest, setEvBind, setWantedEq, setWantedEvTerm, setEvBindIfWanted, newEvVar, newGivenEvVar, newGivenEvVars, @@ -2077,6 +2077,7 @@ checkTouchableTyVarEq ev lhs_tv rhs -- True <=> type families are ok on the RHS = do { traceTcS "checkTouchableTyVarEq: simple-check wins" (ppr lhs_tv $$ ppr rhs) ; return (pure (mkReflRedn Nominal rhs)) } + | otherwise = do { traceTcS "checkTouchableTyVarEq {" (ppr lhs_tv $$ ppr rhs) ; check_result <- wrapTcS (check_rhs rhs) @@ -2125,10 +2126,7 @@ checkTouchableTyVarEq ev lhs_tv rhs checkTypeEq :: CtEvidence -> EqRel -> CanEqLHS -> TcType -> TcS (PuResult () Reduction) -- Used for general CanEqLHSs, ones that do --- not have a touchable type variable on the LHS --- --- For Givens, flatten to avoid an occurs-check --- For Wanteds, don't bother +-- not have a touchable type variable on the LHS (i.e. not unifying) checkTypeEq ev eq_rel lhs rhs | isGiven ev = do { traceTcS "checkTypeEq {" (vcat [ text "lhs:" <+> ppr lhs @@ -2137,10 +2135,9 @@ checkTypeEq ev eq_rel lhs rhs ; traceTcS "checkTypeEq }" (ppr check_result) ; case check_result of PuFail reason -> return (PuFail reason) - PuOK redn prs -> do { let prs_list = bagToList prs - ; new_givens <- mapM mk_new_given prs_list - ; emitWorkNC new_givens - ; updInertTcS (addCycleBreakerBindings prs_list) + PuOK redn prs -> do { new_givens <- mapBagM mk_new_given prs + ; emitWorkNC (bagToList new_givens) + ; updInertTcS (addCycleBreakerBindings prs) ; return (pure redn) } } | otherwise -- Wanted @@ -2163,9 +2160,7 @@ checkTypeEq ev eq_rel lhs rhs , tef_unifying = NotUnifying , tef_fam_app = TEFA_Recurse , tef_occurs = occ_prob } - -- TEFA_Recurse: no point in TEFA_Break, because we would just make - -- [W] beta[tau] ~ F ty (beta fresh) - -- and would then unify beta in the next step. Infinite loop! + -- TEFA_Recurse: see Note [Don't cycle-break Wanteds when not unifying] occ_prob = case eq_rel of NomEq -> cteInsolubleOccurs @@ -2207,3 +2202,44 @@ restoreTyVarCycles is {-# SPECIALISE forAllCycleBreakerBindings_ :: CycleBreakerVarStack -> (TcTyVar -> TcType -> TcM ()) -> TcM () #-} + +{- Note [Don't cycle-break Wanteds when not unifying] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consdier + [W] a[2] ~ Maybe (F a[2]) + +Should we cycle-break this Wanted, thus? + + [W] a[2] ~ Maybe delta[2] + [W] delta[2] ~ F a[2] + +For a start, this is dodgy because we might just unify delta, thus undoing +what we have done, and getting an infinite loop in the solver. Even if we +somehow prevented ourselves from doing so, is there any merit in the split? +Maybe: perhaps we can use that equality on `a` to unlock other constraints? +Consider + type instance F (Maybe _) = Bool + + [G] g1: a ~ Maybe Bool + [W] w1: a ~ Maybe (F a) + +If we loop-break w1 to get + [W] w1': a ~ Maybe gamma + [W] w3: gamma ~ F a +Now rewrite w3 with w1' + [W] w3': gamma ~ F (Maybe gamma) +Now use the type instance to get + gamma := Bool +Now we are left with + [W] w1': a ~ Maybe Bool +which we can solve from the Given. + +BUT in this situation we could have rewritten the +/original/ Wanted from the Given, like this: + [W] w1': Maybe Bool ~ Maybe (F (Maybe Bool)) +and that is readily soluble. + +In short: loop-breaking Wanteds, when we aren't unifying, +seems of no merit. Hence TEFA_Recurse, rather than TEFA_Break, +in `wanted_flags` in `checkTypeEq`. +-} \ No newline at end of file ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -152,7 +152,7 @@ import Data.List ( intersperse ) * * ************************************************************************ -Note [CEqCan occurs check] +Note [EqCt occurs check] ~~~~~~~~~~~~~~~~~~~~~~~~~~ A CEqCan relates a CanEqLHS (a type variable or type family applications) on its left to an arbitrary type on its right. It is used for rewriting. @@ -268,11 +268,9 @@ data Ct {- Note [Invariants of EqCt] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -An EqCt carries a canonical equality constraint, that satisfies these invariants: - * See Note [inert_eqs: the inert equalities] in GHC.Tc.Solver.InertSet - * Many are checked in checkTypeEq in GHC.Tc.Utils.Unify +An EqCt is a canonical equality constraint. It satisfies these invariants: * (TyEq:OC) lhs does not occur in rhs (occurs check) - Note [CEqCan occurs check] + Note [EqCt occurs check] * (TyEq:F) rhs has no foralls (this avoids substituting a forall for the tyvar in other types) * (TyEq:K) typeKind lhs `tcEqKind` typeKind rhs; Note [Ct kind invariant] @@ -284,6 +282,11 @@ An EqCt carries a canonical equality constraint, that satisfies these invariants * (TyEq:TV) If rhs (perhaps under a cast) is also CanEqLHS, then it is oriented to give best chance of unification happening; eg if rhs is touchable then lhs is too Note [TyVar/TyVar orientation] in GHC.Tc.Utils.Unify + +These invariants ensure that the EqCts in inert_eqs constitute a +terminating generalised substitution. See Note [inert_eqs: the inert equalities] +in GHC.Tc.Solver.InertSet for what these words mean! + -} data EqCt -- An equality constraint; see Note [Invariants of EqCt] @@ -502,10 +505,14 @@ cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSkolemEscape :: CheckTyEqProblem cteImpredicative = CTEP (bit 0) -- Forall or (=>) encountered cteTypeFamily = CTEP (bit 1) -- Type family encountered + cteInsolubleOccurs = CTEP (bit 2) -- Occurs-check -cteSolubleOccurs = CTEP (bit 3) -- Occurs-check under a type function or in a coercion - -- must be one bit to the left of cteInsolubleOccurs - -- See also Note [Insoluble occurs check] in GHC.Tc.Errors +cteSolubleOccurs = CTEP (bit 3) -- Occurs-check under a type function, or in a coercion, + -- or in a representational equality; see + -- See Note [Occurs check and representational equality] + -- cteSolubleOccurs must be one bit to the left of cteInsolubleOccurs + -- See also Note [Insoluble occurs check] in GHC.Tc.Errors + cteCoercionHole = CTEP (bit 4) -- Coercion hole encountered cteConcrete = CTEP (bit 5) -- Type variable that can't be made concrete -- e.g. alpha[conc] ~ Maybe beta[tv] ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -21,7 +21,7 @@ module GHC.Tc.Utils.Unify ( -- Various unifications unifyType, unifyKind, unifyExpectedType, uType, promoteTcType, - swapOverTyVars, touchabilityTest, + swapOverTyVars, touchabilityAndShapeTest, -------------------------------- -- Holes @@ -2072,7 +2072,9 @@ uUnfilledVar2 :: CtOrigin uUnfilledVar2 origin t_or_k swapped tv1 ty2 = do { cur_lvl <- getTcLevel -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles - ; if not (touchabilityTest cur_lvl tv1 ty2) + -- Here we don't know about given equalities here; so we treat + -- /any/ level outside this one as untouchable. Hence cur_lvl. + ; if not (touchabilityAndShapeTest cur_lvl tv1 ty2) then not_ok_so_defer else do { check_result <- uTypeCheckTouchableTyVarEq tv1 ty2 @@ -2260,8 +2262,9 @@ Needless to say, all there are wrinkles: isTouchableMetaTyVar. * In the constraint solver, we track where Given equalities occur - and use that to guard unification in GHC.Tc.Solver.Canonical.touchabilityTest - More details in Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet + and use that to guard unification in + GHC.Tc.Solver.Canonical.touchabilityAndShapeTest. More details in + Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet Historical note: in the olden days (pre 2021) the constraint solver also used to unify only if l=n. Equalities were "floated" out of the @@ -2276,8 +2279,8 @@ Note [TyVar/TyVar orientation] See also Note [Fundeps with instances, and equality orientation] where the kind equality orientation is important -Given (a ~ b), should we orient the CEqCan as (a~b) or (b~a)? -This is a surprisingly tricky question! This is invariant (TyEq:TV). +Given (a ~ b), should we orient the equality as (a~b) or (b~a)? +This is a surprisingly tricky question! The question is answered by swapOverTyVars, which is used - in the eager unifier, in GHC.Tc.Utils.Unify.uUnfilledVar1 @@ -2294,11 +2297,9 @@ So we look for a positive reason to swap, using a three-step test: * Priority. If the levels are the same, look at what kind of type variable it is, using 'lhsPriority'. - Generally speaking we always try to put a MetaTv on the left - in preference to SkolemTv or RuntimeUnkTv: - a) Because the MetaTv may be touchable and can be unified - b) Even if it's not touchable, GHC.Tc.Solver.floatConstraints - looks for meta tyvars on the left + Generally speaking we always try to put a MetaTv on the left in + preference to SkolemTv or RuntimeUnkTv, because the MetaTv may be + touchable and can be unified. Tie-breaking rules for MetaTvs: - CycleBreakerTv: This is essentially a stand-in for another type; @@ -2527,6 +2528,8 @@ matchExpectedFunKind hs_ty n k = go n k uTypeCheckTouchableTyVarEq :: TcTyVar -> TcType -> TcM (PuResult () TcType) -- The check may expand type synonyms to avoid an occurs check, -- so we must use the return type +-- +-- Precondition: rhs is fully zonked uTypeCheckTouchableTyVarEq lhs_tv rhs | simpleUnifyCheck False lhs_tv rhs -- Do a fast-path check -- False <=> See Note [Prevent unification with type families] @@ -2580,7 +2583,8 @@ simpleUnifyCheck fam_ok lhs_tv rhs go w && go a && go r go (TyConApp tc tys) | lhs_tv_is_concrete, not (isConcreteTyCon tc) = False - | not fam_ok, isTypeFamilyTyCon tc = False + | not (isTauTyCon tc) = False + | not fam_ok, not (isFamFreeTyCon tc) = False | otherwise = all go tys go (AppTy t1 t2) = go t1 && go t2 go (ForAllTy {}) = False @@ -2838,6 +2842,7 @@ checkTyEqRhs flags ty ------------------- checkCo :: TyEqFlags a -> Coercion -> TcM (PuResult a Coercion) +-- See Note [checkCo] checkCo (TEF { tef_lhs = TyFamLHS {} }) co = return (PuOK co emptyBag) @@ -2852,7 +2857,7 @@ checkCo (TEF { tef_lhs = TyVarLHS lhs_tv -- Occurs check (can promote) | Unifying _ lhs_tv_lvl LC_Promote <- unifying - = do { reason <- checkFreeVars occ_prob lhs_tv lhs_tv_lvl (tyCoVarsOfCo co) + = do { reason <- checkPromoteFreeVars occ_prob lhs_tv lhs_tv_lvl (tyCoVarsOfCo co) ; if cterHasNoProblem reason then return (pure co) else failCheckWith reason } @@ -2864,6 +2869,66 @@ checkCo (TEF { tef_lhs = TyVarLHS lhs_tv | otherwise = return (PuOK co emptyBag) +{- Note [checkCo] +~~~~~~~~~~~~~~~~~ +We don't often care about the contents of coercions, so checking +coercions before making an equality constraint may be surprising. +But there are several cases we need to be wary of: + +(1) When we're unifying a variable, we must make sure that the variable + appears nowhere on the RHS -- even in a coercion. Otherwise, we'll + create a loop. + +(2) We must still make sure that no variable in a coercion is at too + high a level. But, when unifying, we can promote any variables we encounter. + +(3) We do not unify variables with a type with a free coercion hole. + See (COERCION-HOLE) in Note [Unification preconditons]. + + +Note [Promotion and level-checking] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +"Promotion" happens when we have this: + + [W] w1: alpha[2] ~ Maybe beta[4] + [W] w2: alpha[2] ~ Maybe (F gamma beta[4]) + +In `w1` we must NOT unify alpha := Maybe beta, because beta +may turn out to stand for a type involving some inner skolem. +Yikes! Skolem-escape. So instead we /promote/ beta, like this: + + beta[4] := beta'[2] + [W] w1: alpha[2] ~ Maybe beta'[2] + +Now we can unify alpha := Maybe beta', which might unlock other +constraints. But if some other constraint wants to unify beta with a +nested skolem, it'll get stuck with a skolem-escape error. + +In `w2`, it may or may not be the case that `beta` is level 2; suppose +we later discover gamma := Int, and type instance F Int _ = Int. +So we promote the entire funcion call: + + [W] w2': alpha[2] ~ Maybe gamma[2] + [W] w3: gamma[2] ~ F gamma beta[4] + +Now we can unify alpha := Maybe gamma, which is a Good Thng. + +Wrinkle (W1) + +There is an important wrinkle: /all this only applies when unifying/. +For example, suppose we have + [G] a[2] ~ Maybe b[4] +where 'a' is a skolem. This Given might arise from a GADT match, and +we can absolutely use it to rewrite locally. In fact we must do so: +that is how we exploit local knowledge about the outer skolem a[2]. +This applies equally for a Wanted [W] a[2] ~ Maybe b[4]. Using it for +local rewriting is fine. (It's not clear to me that it is /useful/, +but it's fine anyway.) + +So we only do the level in checkTyVar when /unifying/ not for skolems +(or untouchable unification variables). +-} + ------------------- checkTyConApp :: TyEqFlags a -> TcType -> TyCon -> [TcType] @@ -2947,6 +3012,8 @@ checkTyVar (TEF { tef_lhs = lhs, tef_unifying = unifying, tef_occurs = occ_prob --------------------- check_tv NotUnifying lhs_tv + -- We need an occurs-check here, but no level check + -- See Note [No level-check or promotion when not unifying] | occursCheckTv lhs_tv occ_tv = failCheckWith (cteProblem occ_prob) | otherwise @@ -2955,7 +3022,13 @@ checkTyVar (TEF { tef_lhs = lhs, tef_unifying = unifying, tef_occurs = occ_prob check_tv (Unifying info lvl LC_Promote) lhs_tv = do { mb_done <- isFilledMetaTyVar_maybe occ_tv ; case mb_done of - Just {} -> success -- Already promoted; job done + Just {} -> success + -- Already promoted; job done + -- Example alpha[2] ~ Maybe (beta[4], beta[4]) + -- We promote the first occurrence, and then encounter it + -- a second time; we don't want to re-promote it! + -- Remember, the entire process started with a fully zonked type + Nothing -> check_unif info lvl LC_Promote lhs_tv } check_tv (Unifying info lvl prom) lhs_tv = check_unif info lvl prom lhs_tv @@ -3004,7 +3077,7 @@ checkTyVar (TEF { tef_lhs = lhs, tef_unifying = unifying, tef_occurs = occ_prob new_lvl = lhs_tv_lvl `minTcLevel` lvl_occ -- c[conc,3] ~ p[tau,2]: want to clone p:=p'[conc,2] -- c[tau,2] ~ p[tau,3]: want to clone p:=p'[tau,2] - ; reason <- checkFreeVars occ_prob lhs_tv lhs_tv_lvl (tyCoVarsOfType (tyVarKind occ_tv)) + ; reason <- checkPromoteFreeVars occ_prob lhs_tv lhs_tv_lvl (tyCoVarsOfType (tyVarKind occ_tv)) ; if cterHasNoProblem reason -- Successfully promoted then do { new_tv_ty <- promote_meta_tyvar new_info new_lvl occ_tv ; okCheckRefl new_tv_ty } @@ -3012,13 +3085,13 @@ checkTyVar (TEF { tef_lhs = lhs, tef_unifying = unifying, tef_occurs = occ_prob | otherwise = pprPanic "promote" (ppr occ_tv) ------------------------- -checkFreeVars :: CheckTyEqProblem -- Occurs check problem - -> TcTyVar -> TcLevel - -> TyCoVarSet -> TcM CheckTyEqResult +checkPromoteFreeVars :: CheckTyEqProblem -- What occurs check problem to report + -> TcTyVar -> TcLevel + -> TyCoVarSet -> TcM CheckTyEqResult -- Check this set of TyCoVars for -- (a) occurs check -- (b) promote if necessary, or report skolem escape -checkFreeVars occ_prob lhs_tv lhs_tv_lvl vs +checkPromoteFreeVars occ_prob lhs_tv lhs_tv_lvl vs = do { oks <- mapM do_one (nonDetEltsUniqSet vs) ; return (mconcat oks) } where @@ -3059,11 +3132,11 @@ promote_meta_tyvar info dest_lvl occ_tv ------------------------- -touchabilityTest :: TcLevel -> TcTyVar -> TcType -> Bool +touchabilityAndShapeTest :: TcLevel -> TcTyVar -> TcType -> Bool -- This is the key test for untouchability: -- See Note [Unification preconditions] in GHC.Tc.Utils.Unify -- and Note [Solve by unification] in GHC.Tc.Solver.Interact -touchabilityTest given_eq_lvl tv rhs +touchabilityAndShapeTest given_eq_lvl tv rhs | MetaTv { mtv_info = info, mtv_tclvl = tv_lvl } <- tcTyVarDetails tv , checkTopShape info rhs = tv_lvl `deeperThanOrSame` given_eq_lvl ===================================== testsuite/tests/polykinds/T14939.hs ===================================== @@ -12,10 +12,8 @@ newtype Frí (cls::Type -> Constraint) :: (Type -> Alg cls Type) where Frí :: { with :: forall x. cls x => (a -> x) -> x } -> Frí cls a -{- data AlgCat (cls::Type -> Constraint) :: Cat (Alg cls Type) where AlgCat :: (cls a, cls b) => (a -> b) -> AlgCat cls a b leftAdj :: AlgCat cls (Frí cls a) b -> (a -> b) leftAdj (AlgCat f) a = undefined --} \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e122c94f4828f6bd1da7e11b2e3cd4cd61e4965 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e122c94f4828f6bd1da7e11b2e3cd4cd61e4965 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 17 18:36:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 17 Mar 2023 14:36:16 -0400 Subject: [Git][ghc/ghc][master] ghci: only keep the GlobalRdrEnv in ModInfo Message-ID: <6414b3202a468_20ac849bbb094217667@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 4 changed files: - compiler/GHC.hs - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -1304,8 +1304,7 @@ compileCore simplify fn = do else return $ Right mod_guts - Nothing -> panic "compileToCoreModule: target FilePath not found in\ - module dependency graph" + Nothing -> panic "compileToCoreModule: target FilePath not found in module dependency graph" where -- two versions, based on whether we simplify (thus run tidyProgram, -- which returns a (CgGuts, ModDetails) pair, or not (in which case -- we just have a ModGuts. ===================================== ghc/GHCi/UI.hs ===================================== @@ -2346,8 +2346,12 @@ typeAtCmd str = runExceptGhciMonad $ do (span',sample) <- exceptT $ parseSpanArg str infos <- lift $ mod_infos <$> getGHCiState (info, ty) <- findType infos span' sample - lift $ printForUserModInfo (modinfoInfo info) - (sep [text sample,nest 2 (dcolon <+> ppr ty)]) + let mb_rdr_env = case modinfoRdrEnv info of + Strict.Just rdrs -> Just rdrs + Strict.Nothing -> Nothing + lift $ printForUserGlobalRdrEnv + mb_rdr_env + (sep [text sample,nest 2 (dcolon <+> ppr ty)]) ----------------------------------------------------------------------------- -- | @:uses@ command ===================================== ghc/GHCi/UI/Info.hs ===================================== @@ -42,6 +42,7 @@ import GHC.Driver.Monad import GHC.Driver.Env import GHC.Driver.Ppr import GHC.Types.Name +import GHC.Types.Name.Reader import GHC.Types.Name.Set import GHC.Utils.Outputable import GHC.Types.SrcLoc @@ -58,9 +59,8 @@ data ModInfo = ModInfo -- ^ Generated set of information about all spans in the -- module that correspond to some kind of identifier for -- which there will be type info and/or location info. - , modinfoInfo :: !ModuleInfo - -- ^ Again, useful from GHC for accessing information - -- (exports, instances, scope) from a module. + , modinfoRdrEnv :: !(Strict.Maybe GlobalRdrEnv) + -- ^ What's in scope in the module. , modinfoLastUpdate :: !UTCTime -- ^ The timestamp of the file used to generate this record. } @@ -174,9 +174,9 @@ findName infos span0 mi string = UnhelpfulSpan {} -> tryExternalModuleResolution RealSrcSpan {} -> return (getName name) where + rdrs = modInfo_rdrs mi tryExternalModuleResolution = - case find (matchName $ mkFastString string) - (fromMaybe [] (modInfoTopLevelScope (modinfoInfo mi))) of + case find (matchName $ mkFastString string) rdrs of Nothing -> throwE "Couldn't resolve to any modules." Just imported -> resolveNameFromModule infos imported @@ -198,8 +198,10 @@ resolveNameFromModule infos name = do ppr modL)) return $ M.lookup (moduleName modL) infos + let all_names = modInfo_rdrs info + maybe (throwE "No matching export in any local modules.") return $ - find (matchName name) (modInfoExports (modinfoInfo info)) + find (matchName name) all_names where matchName :: Name -> Name -> Bool matchName x y = occNameFS (getOccName x) == @@ -311,9 +313,25 @@ getModInfo name = do p <- parseModule m typechecked <- typecheckModule p let allTypes = processAllTypeCheckedModule typechecked - let i = tm_checked_module_info typechecked + module_info = tm_checked_module_info typechecked + !rdr_env = case modInfoRdrEnv module_info of + Just rdrs -> Strict.Just rdrs + Nothing -> Strict.Nothing ts <- liftIO $ getModificationTime $ srcFilePath m - return (ModInfo m allTypes i ts) + return $ + ModInfo + { modinfoSummary = m + , modinfoSpans = allTypes + , modinfoRdrEnv = rdr_env + , modinfoLastUpdate = ts + } + +-- | Get the 'Name's from the 'GlobalRdrEnv' of the 'ModInfo', if any. +modInfo_rdrs :: ModInfo -> [Name] +modInfo_rdrs mi = + case modinfoRdrEnv mi of + Strict.Nothing -> [] + Strict.Just env -> map greMangledName $ globalRdrEnvElts env -- | Get ALL source spans in the module. processAllTypeCheckedModule :: TypecheckedModule -> [SpanInfo] ===================================== ghc/GHCi/UI/Monad.hs ===================================== @@ -24,7 +24,8 @@ module GHCi.UI.Monad ( runStmt, runDecls, runDecls', resume, recordBreak, revertCAFs, ActionStats(..), runAndPrintStats, runWithStats, printStats, - printForUserNeverQualify, printForUserModInfo, + printForUserNeverQualify, + printForUserModInfo, printForUserGlobalRdrEnv, printForUser, printForUserPartWay, prettyLocations, compileGHCiExpr, @@ -41,6 +42,7 @@ import GHC.Driver.Monad hiding (liftIO) import GHC.Utils.Outputable import qualified GHC.Driver.Ppr as Ppr import GHC.Types.Name.Occurrence +import GHC.Types.Name.Reader import GHC.Driver.Session import GHC.Data.FastString import GHC.Driver.Env @@ -49,6 +51,7 @@ import GHC.Types.SafeHaskell import GHC.Driver.Make (ModIfaceCache(..)) import GHC.Unit import GHC.Types.Name.Reader as RdrName (mkOrig) +import qualified GHC.Types.Name.Ppr as Ppr (mkNamePprCtx ) import GHC.Builtin.Names (gHC_GHCI_HELPERS) import GHC.Runtime.Interpreter import GHC.Runtime.Context @@ -362,11 +365,20 @@ printForUserNeverQualify doc = do liftIO $ Ppr.printForUser dflags stdout neverQualify AllTheWay doc printForUserModInfo :: GhcMonad m => GHC.ModuleInfo -> SDoc -> m () -printForUserModInfo info doc = do +printForUserModInfo info = printForUserGlobalRdrEnv (GHC.modInfoRdrEnv info) + +printForUserGlobalRdrEnv :: GhcMonad m => Maybe GlobalRdrEnv -> SDoc -> m () +printForUserGlobalRdrEnv mb_rdr_env doc = do dflags <- GHC.getInteractiveDynFlags - m_name_ppr_ctx <- GHC.mkNamePprCtxForModule info - name_ppr_ctx <- maybe GHC.getNamePprCtx return m_name_ppr_ctx + name_ppr_ctx <- mkNamePprCtxFromGlobalRdrEnv dflags mb_rdr_env liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc + where + mkNamePprCtxFromGlobalRdrEnv _ Nothing = GHC.getNamePprCtx + mkNamePprCtxFromGlobalRdrEnv dflags (Just rdr_env) = + withSession $ \ hsc_env -> + let unit_env = hsc_unit_env hsc_env + ptc = initPromotionTickContext dflags + in return $ Ppr.mkNamePprCtx ptc unit_env rdr_env printForUser :: GhcMonad m => SDoc -> m () printForUser doc = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/19d6d0397c223bbec3c372d2b8c04c2e356c44a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/19d6d0397c223bbec3c372d2b8c04c2e356c44a8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 17 18:37:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 17 Mar 2023 14:37:08 -0400 Subject: [Git][ghc/ghc][master] Add structured error messages for GHC.Tc.Utils.Backpack Message-ID: <6414b3546c038_20ac849d19274221576@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - 15 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Shape.hs - testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr - testsuite/tests/backpack/should_fail/bkpfail01.stderr - testsuite/tests/backpack/should_fail/bkpfail05.stderr - testsuite/tests/backpack/should_fail/bkpfail09.stderr - testsuite/tests/backpack/should_fail/bkpfail16.stderr - testsuite/tests/backpack/should_fail/bkpfail20.stderr - testsuite/tests/backpack/should_fail/bkpfail21.stderr - testsuite/tests/backpack/should_fail/bkpfail35.stderr - testsuite/tests/backpack/should_fail/bkpfail37.stderr - testsuite/tests/backpack/should_fail/bkpfail38.stderr Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -73,6 +73,7 @@ import GHC.Types.Unique.Set ( nonDetEltsUniqSet ) import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env +import GHC.Types.Fixity (defaultFixity) import GHC.Unit.State (pprWithUnitState, UnitState) import GHC.Unit.Module @@ -994,6 +995,32 @@ instance Diagnostic TcRnMessage where TcRnIllegalHsigDefaultMethods name meths -> mkSimpleDecorated $ text "Illegal default method" <> plural (NE.toList meths) <+> text "in class definition of" <+> ppr name <+> text "in hsig file" + TcRnHsigFixityMismatch real_thing real_fixity sig_fixity + -> + let ppr_fix f = ppr f <+> if f == defaultFixity then parens (text "default") else empty + in mkSimpleDecorated $ + vcat [ppr real_thing <+> text "has conflicting fixities in the module", + text "and its hsig file", + text "Main module:" <+> ppr_fix real_fixity, + text "Hsig file:" <+> ppr_fix sig_fixity] + TcRnHsigShapeMismatch (HsigShapeSortMismatch info1 info2) + -> mkSimpleDecorated $ + text "While merging export lists, could not combine" + <+> ppr info1 <+> text "with" <+> ppr info2 + <+> parens (text "one is a type, the other is a plain identifier") + TcRnHsigShapeMismatch (HsigShapeNotUnifiable name1 name2 notHere) + -> + let extra = if notHere + then text "Neither name variable originates from the current signature." + else empty + in mkSimpleDecorated $ + text "While merging export lists, could not unify" + <+> ppr name1 <+> text "with" <+> ppr name2 $$ extra + TcRnHsigMissingModuleExport occ unit_state impl_mod + -> mkSimpleDecorated $ + quotes (ppr occ) + <+> text "is exported by the hsig file, but not exported by the implementing module" + <+> quotes (pprWithUnitState unit_state $ ppr impl_mod) TcRnBadGenericMethod clas op -> mkSimpleDecorated $ hsep [text "Class", quotes (ppr clas), @@ -1726,6 +1753,12 @@ instance Diagnostic TcRnMessage where -> WarningWithFlag Opt_WarnWarningsDeprecations TcRnIllegalHsigDefaultMethods{} -> ErrorWithoutFlag + TcRnHsigFixityMismatch{} + -> ErrorWithoutFlag + TcRnHsigShapeMismatch{} + -> ErrorWithoutFlag + TcRnHsigMissingModuleExport{} + -> ErrorWithoutFlag TcRnBadGenericMethod{} -> ErrorWithoutFlag TcRnWarningMinimalDefIncomplete{} @@ -2196,6 +2229,12 @@ instance Diagnostic TcRnMessage where -> noHints TcRnIllegalHsigDefaultMethods{} -> noHints + TcRnHsigFixityMismatch{} + -> noHints + TcRnHsigShapeMismatch{} + -> noHints + TcRnHsigMissingModuleExport{} + -> noHints TcRnBadGenericMethod{} -> noHints TcRnWarningMinimalDefIncomplete{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -91,6 +91,7 @@ module GHC.Tc.Errors.Types ( , DeclSort(..) , NonStandardGuards(..) , RuleLhsErrReason(..) + , HsigShapeMismatchReason(..) ) where import GHC.Prelude @@ -105,6 +106,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , FixedRuntimeRepOrigin(..) ) import GHC.Tc.Types.Rank (Rank) import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType) +import GHC.Types.Avail (AvailInfo) import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) import GHC.Types.ForeignCall (CLabelString) @@ -2239,10 +2241,39 @@ data TcRnMessage where Test case: bkpfail40 -} - TcRnIllegalHsigDefaultMethods :: !Name -- ^ 'Name' of the class -> NE.NonEmpty (LHsBind GhcRn) -- ^ default methods -> TcRnMessage + + {-| TcRnHsigFixityMismatch is an error indicating that the fixity decl in a + Backpack signature file differs from the one in the source file for the same + operator. + + Test cases: + bkpfail37, bkpfail38 + -} + TcRnHsigFixityMismatch :: !TyThing -- ^ The operator whose fixity is defined + -> !Fixity -- ^ the fixity used in the source file + -> !Fixity -- ^ the fixity used in the signature + -> TcRnMessage + + {-| TcRnHsigShapeMismatch is a group of errors related to mismatches between + backpack signatures. + -} + TcRnHsigShapeMismatch :: !HsigShapeMismatchReason + -> TcRnMessage + + {-| TcRnHsigMissingModuleExport is an error indicating that a module doesn't + export a name exported by its signature. + + Test cases: + bkpfail01, bkpfail05, bkpfail09, bkpfail16, bkpfail35, bkpcabal06 + -} + TcRnHsigMissingModuleExport :: !OccName -- ^ The missing name + -> !UnitState -- ^ The module's unit state + -> !Module -- ^ The implementation module + -> TcRnMessage + {-| TcRnBadGenericMethod This test ensures that if you provide a "more specific" type signatures for the default method, you must also provide a binding. @@ -4419,3 +4450,24 @@ data NonStandardGuards where data RuleLhsErrReason = UnboundVariable RdrName NotInScopeError | IllegalExpression + +data HsigShapeMismatchReason = + {-| HsigShapeSortMismatch is an error indicating that an item in the + export list of a signature doesn't match the item of the same name in + another signature when merging the two – one is a type while the other is a + plain identifier. + + Test cases: + none + -} + HsigShapeSortMismatch !AvailInfo !AvailInfo + | + {-| HsigShapeNotUnifiable is an error indicating that a name in the + export list of a signature cannot be unified with a name of the same name in + another signature when merging the two. + + Test cases: + bkpfail20, bkpfail21 + -} + HsigShapeNotUnifiable !Name !Name !Bool + deriving (Generic) ===================================== compiler/GHC/Tc/Utils/Backpack.hs ===================================== @@ -88,21 +88,6 @@ import Data.List (find) import {-# SOURCE #-} GHC.Tc.Module - -fixityMisMatch :: TyThing -> Fixity -> Fixity -> TcRnMessage -fixityMisMatch real_thing real_fixity sig_fixity = - mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ppr real_thing <+> text "has conflicting fixities in the module", - text "and its hsig file", - text "Main module:" <+> ppr_fix real_fixity, - text "Hsig file:" <+> ppr_fix sig_fixity] - where - ppr_fix f = - ppr f <+> - (if f == defaultFixity - then parens (text "default") - else empty) - checkHsigDeclM :: ModIface -> TyThing -> TyThing -> TcRn () checkHsigDeclM sig_iface sig_thing real_thing = do let name = getName real_thing @@ -115,7 +100,7 @@ checkHsigDeclM sig_iface sig_thing real_thing = do Just f -> f when (real_fixity /= sig_fixity) $ addErrAt (nameSrcSpan name) - (fixityMisMatch real_thing real_fixity sig_fixity) + (TcRnHsigFixityMismatch real_thing real_fixity sig_fixity) -- | Given a 'ModDetails' of an instantiated signature (note that the -- 'ModDetails' must be knot-tied consistently with the actual implementation) @@ -677,7 +662,7 @@ mergeSignatures -- 3(d). Extend the name substitution (performing shaping) mb_r <- extend_ns nsubst as2 case mb_r of - Left err -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints err) + Left err -> failWithTc (TcRnHsigShapeMismatch err) Right nsubst' -> return (nsubst',oks',(imod, thinned_iface):ifaces) nsubst0 = mkNameShape (moduleName inner_mod) (mi_exports lcl_iface0) ok_to_use0 = mkOccSet (exportOccs (mi_exports lcl_iface0)) @@ -1004,10 +989,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do -- we need. (Notice we IGNORE the Modules in the AvailInfos.) forM_ (exportOccs (mi_exports isig_iface)) $ \occ -> case lookupGlobalRdrEnv impl_gr occ of - [] -> addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - quotes (ppr occ) - <+> text "is exported by the hsig file, but not exported by the implementing module" - <+> quotes (pprWithUnitState unit_state $ ppr impl_mod) + [] -> addErr $ TcRnHsigMissingModuleExport occ unit_state impl_mod _ -> return () failIfErrsM ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -471,6 +471,11 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnIllegalTypeOperatorDecl" = 50649 GhcDiagnosticCode "TcRnIllegalHsigDefaultMethods" = 93006 + GhcDiagnosticCode "TcRnHsigFixityMismatch" = 93007 + GhcDiagnosticCode "HsigShapeSortMismatch" = 93008 + GhcDiagnosticCode "HsigShapeNotUnifiable" = 93009 + GhcDiagnosticCode "TcRnHsigNoIface" = 93010 + GhcDiagnosticCode "TcRnHsigMissingModuleExport" = 93011 GhcDiagnosticCode "TcRnBadGenericMethod" = 59794 GhcDiagnosticCode "TcRnWarningMinimalDefIncomplete" = 13511 GhcDiagnosticCode "TcRnDefaultMethodForPragmaLacksBinding" = 28587 @@ -691,6 +696,7 @@ type family ConRecursInto con where ConRecursInto "TcRnPragmaWarning" = 'Just (WarningTxt GhcRn) ConRecursInto "TcRnNotInScope" = 'Just NotInScopeError ConRecursInto "TcRnIllegalNewtype" = 'Just IllegalNewtypeReason + ConRecursInto "TcRnHsigShapeMismatch" = 'Just HsigShapeMismatchReason -- -- TH errors ===================================== compiler/GHC/Types/Name/Shape.hs ===================================== @@ -25,8 +25,8 @@ import GHC.Types.Name.Env import GHC.Tc.Utils.Monad import GHC.Iface.Env +import GHC.Tc.Errors.Types -import GHC.Utils.Outputable import GHC.Utils.Panic.Plain import Control.Monad @@ -106,7 +106,7 @@ mkNameShape mod_name as = -- restricted notion of shaping than in Backpack'14: we do shaping -- *as* we do type-checking. Thus, once we shape a signature, its -- exports are *final* and we're not allowed to refine them further, -extendNameShape :: HscEnv -> NameShape -> [AvailInfo] -> IO (Either SDoc NameShape) +extendNameShape :: HscEnv -> NameShape -> [AvailInfo] -> IO (Either HsigShapeMismatchReason NameShape) extendNameShape hsc_env ns as = case uAvailInfos (ns_mod_name ns) (ns_exports ns) as of Left err -> return (Left err) @@ -224,7 +224,7 @@ mergeAvails as1 as2 = -- | Unify two lists of 'AvailInfo's, given an existing substitution @subst@, -- with only name holes from @flexi@ unifiable (all other name holes rigid.) -uAvailInfos :: ModuleName -> [AvailInfo] -> [AvailInfo] -> Either SDoc ShNameSubst +uAvailInfos :: ModuleName -> [AvailInfo] -> [AvailInfo] -> Either HsigShapeMismatchReason ShNameSubst uAvailInfos flexi as1 as2 = -- pprTrace "uAvailInfos" (ppr as1 $$ ppr as2) $ let mkOE as = listToUFM $ do a <- as n <- availNames a @@ -236,34 +236,27 @@ uAvailInfos flexi as1 as2 = -- pprTrace "uAvailInfos" (ppr as1 $$ ppr as2) $ -- | Unify two 'AvailInfo's, given an existing substitution @subst@, -- with only name holes from @flexi@ unifiable (all other name holes rigid.) uAvailInfo :: ModuleName -> ShNameSubst -> AvailInfo -> AvailInfo - -> Either SDoc ShNameSubst + -> Either HsigShapeMismatchReason ShNameSubst uAvailInfo flexi subst (Avail (NormalGreName n1)) (Avail (NormalGreName n2)) = uName flexi subst n1 n2 uAvailInfo flexi subst (AvailTC n1 _) (AvailTC n2 _) = uName flexi subst n1 n2 -uAvailInfo _ _ a1 a2 = Left $ text "While merging export lists, could not combine" - <+> ppr a1 <+> text "with" <+> ppr a2 - <+> parens (text "one is a type, the other is a plain identifier") +uAvailInfo _ _ a1 a2 = Left $ HsigShapeSortMismatch a1 a2 -- | Unify two 'Name's, given an existing substitution @subst@, -- with only name holes from @flexi@ unifiable (all other name holes rigid.) -uName :: ModuleName -> ShNameSubst -> Name -> Name -> Either SDoc ShNameSubst +uName :: ModuleName -> ShNameSubst -> Name -> Name -> Either HsigShapeMismatchReason ShNameSubst uName flexi subst n1 n2 | n1 == n2 = Right subst | isFlexi n1 = uHoleName flexi subst n1 n2 | isFlexi n2 = uHoleName flexi subst n2 n1 - | otherwise = Left (text "While merging export lists, could not unify" - <+> ppr n1 <+> text "with" <+> ppr n2 $$ extra) + | otherwise = Left (HsigShapeNotUnifiable n1 n2 (isHoleName n1 || isHoleName n2)) where isFlexi n = isHoleName n && moduleName (nameModule n) == flexi - extra | isHoleName n1 || isHoleName n2 - = text "Neither name variable originates from the current signature." - | otherwise - = empty -- | Unify a name @h@ which 'isHoleName' with another name, given an existing -- substitution @subst@, with only name holes from @flexi@ unifiable (all -- other name holes rigid.) uHoleName :: ModuleName -> ShNameSubst -> Name {- hole name -} -> Name - -> Either SDoc ShNameSubst + -> Either HsigShapeMismatchReason ShNameSubst uHoleName flexi subst h n = assert (isHoleName h) $ case lookupNameEnv subst h of ===================================== testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr ===================================== @@ -1,4 +1,4 @@ -sig/P.hsig:1:1: error: +sig/P.hsig:1:1: error: [GHC-93011] • ‘p’ is exported by the hsig file, but not exported by the implementing module ‘bkpcabal06-0.1.0.0:impl:P’ • while checking that bkpcabal06-0.1.0.0:impl:P implements signature P in bkpcabal06-0.1.0.0:sig[P=bkpcabal06-0.1.0.0:impl:P] ===================================== testsuite/tests/backpack/should_fail/bkpfail01.stderr ===================================== @@ -10,10 +10,10 @@ Instantiating p[H=q:H] [1 of 2] Compiling H[sig] ( p/H.hsig, nothing ) -bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: +bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: [GHC-93011] • ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’ • while checking that q:H implements signature H in p[H=q:H] -bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: +bkpfail01.out/p/p-D5Mg3foBSCrDbQDKH4WGSG/../H.hi:1:1: error: [GHC-93011] • ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’ • while checking that q:H implements signature H in p[H=q:H] ===================================== testsuite/tests/backpack/should_fail/bkpfail05.stderr ===================================== @@ -18,6 +18,6 @@ Instantiating h[H=h-impl:H] [1 of 1] Compiling H[sig] ( h/H.hsig, bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/H.o ) -bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/../H.hi:1:1: error: +bkpfail05.out/h/h-5FYQgnNkfSvBT5yogOxPpf/../H.hi:1:1: error: [GHC-93011] • ‘T1’ is exported by the hsig file, but not exported by the implementing module ‘h-impl:H’ • while checking that h-impl:H implements signature H in h[H=h-impl:H] ===================================== testsuite/tests/backpack/should_fail/bkpfail09.stderr ===================================== @@ -8,10 +8,10 @@ [1 of 3] Compiling H2[sig] ( r/H2.hsig, nothing ) [2 of 3] Instantiating p -Command line argument: -unit-id p[H=H]:0:0: error: +Command line argument: -unit-id p[H=H]:0:0: error: [GHC-93011] • ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’ • while checking that q:H implements signature H in p[H=q:H] -Command line argument: -unit-id p[H=H]:0:0: error: +Command line argument: -unit-id p[H=H]:0:0: error: [GHC-93011] • ‘H’ is exported by the hsig file, but not exported by the implementing module ‘q:H’ • while checking that q:H implements signature H in p[H=q:H] ===================================== testsuite/tests/backpack/should_fail/bkpfail16.stderr ===================================== @@ -6,6 +6,6 @@ Instantiating p[ShouldFail=base-4.13.0.0:Data.Bool] [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/ShouldFail.o ) -bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/../ShouldFail.hi:1:1: error: +bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/../ShouldFail.hi:1:1: error: [GHC-93011] • ‘Booly’ is exported by the hsig file, but not exported by the implementing module ‘Data.Bool’ • while checking that Data.Bool implements signature ShouldFail in p[ShouldFail=Data.Bool] ===================================== testsuite/tests/backpack/should_fail/bkpfail20.stderr ===================================== @@ -5,7 +5,7 @@ [3 of 3] Processing r [1 of 3] Compiling B[sig] ( r/B.hsig, nothing ) -bkpfail20.bkp:1:1: error: +bkpfail20.bkp:1:1: error: [GHC-93009] • While merging export lists, could not unify Data.STRef.Lazy.newSTRef with GHC.STRef.newSTRef • while merging the signatures from: • p[A=]:A ===================================== testsuite/tests/backpack/should_fail/bkpfail21.stderr ===================================== @@ -9,7 +9,7 @@ [2 of 5] Compiling H1[sig] ( r/H1.hsig, nothing ) [3 of 5] Compiling H3[sig] ( r/H3.hsig, nothing ) -bkpfail21.bkp:1:1: error: +bkpfail21.bkp:1:1: error: [GHC-93009] • While merging export lists, could not unify {H1.T} with {H2.T} Neither name variable originates from the current signature. • while merging the signatures from: ===================================== testsuite/tests/backpack/should_fail/bkpfail35.stderr ===================================== @@ -13,6 +13,6 @@ Instantiating q[A=aimpl:A] [1 of 1] Compiling A[sig] ( q/A.hsig, bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/A.o ) -bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/../A.hi:1:1: error: +bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/../A.hi:1:1: error: [GHC-93011] • ‘y’ is exported by the hsig file, but not exported by the implementing module ‘aimpl:A’ • while checking that aimpl:A implements signature A in q[A=aimpl:A] ===================================== testsuite/tests/backpack/should_fail/bkpfail37.stderr ===================================== @@ -9,7 +9,7 @@ Instantiating p[A=q:A] [1 of 1] Compiling A[sig] ( p/A.hsig, bkpfail37.out/p/p-HVmFlcYSefiK5n1aDP1v7x/A.o ) -bkpfail37.bkp:9:9: error: +bkpfail37.bkp:9:9: error: [GHC-93007] • Identifier ‘op’ has conflicting fixities in the module and its hsig file Main module: infixr 4 ===================================== testsuite/tests/backpack/should_fail/bkpfail38.stderr ===================================== @@ -5,7 +5,7 @@ [3 of 3] Processing r [1 of 3] Compiling A[sig] ( r/A.hsig, nothing ) -bkpfail38.bkp:8:9: error: +bkpfail38.bkp:8:9: error: [GHC-93007] • Identifier ‘op’ has conflicting fixities in the module and its hsig file Main module: infixr 4 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73d07c6e1986bd2b3516d4f009cc1e30ba804f06 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73d07c6e1986bd2b3516d4f009cc1e30ba804f06 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 17 18:59:05 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Fri, 17 Mar 2023 14:59:05 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23134 Message-ID: <6414b879649e8_20ac84a6fda7422237c@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T23134 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23134 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 17 23:16:31 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 17 Mar 2023 19:16:31 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 64 commits: rts: Drop redundant prototype Message-ID: <6414f4cf6a143_20ac84f319d7c23877b@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 097fbdb0 by Apoorv Ingle at 2023-03-16T16:16:20-05:00 Start of HsExpand for HsDo Fixes for #18324 - - - - - 1d733b6a by Apoorv Ingle at 2023-03-17T18:15:00-05:00 - fixed rec with mfix, make sure fail is used for pattern failures - Lexer fails with missing MonadFail instance for P. Looks like a qualified name problem correct instance not being imported problem - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Utils/TmpFs.hs - docs/users_guide/9.8.1-notes.rst - hadrian/doc/user-settings.md - hadrian/src/Expression.hs - hadrian/src/Flavour.hs - hadrian/src/Oracles/Flavour.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Quick.hs - hadrian/src/Settings/Packages.hs - libraries/Win32 - libraries/ghc-bignum/ghc-bignum.cabal - libraries/ghc-heap/tests/all.T - m4/fp_find_cxx_std_lib.m4 - rts/Capability.c - rts/Capability.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5af2773cc5a5c6763037c47050c4b9ee2a93015a...1d733b6ab380a0943b43edd861e02412b92d99fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5af2773cc5a5c6763037c47050c4b9ee2a93015a...1d733b6ab380a0943b43edd861e02412b92d99fc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 17 23:25:41 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 17 Mar 2023 19:25:41 -0400 Subject: [Git][ghc/ghc][wip/expand-do] - fixed rec with mfix, make sure fail is used for pattern failures Message-ID: <6414f6f57295b_20ac84f7800c82389a4@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 3a188995 by Apoorv Ingle at 2023-03-17T18:25:27-05:00 - fixed rec with mfix, make sure fail is used for pattern failures - Lexer fails with missing MonadFail instance for P. Looks like a qualified name problem correct instance not being imported problem - - - - - 5 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - testsuite/tests/rebindable/T18324.hs - testsuite/tests/rebindable/all.T - + testsuite/tests/rebindable/pattern-fails.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1055,11 +1055,12 @@ data HsExpansion orig expanded = HsExpanded orig expanded deriving Data --- | Just print the original expression (the @a@). +-- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - (ppr orig) + -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + -- (ppr orig) + = ppr orig <+> braces (text "Expansion:" <+> ppr expanded) {- @@ -1961,6 +1962,13 @@ matchDoContextErrString (MDoExpr m) = prependQualified m (text "'mdo' block") matchDoContextErrString ListComp = text "list comprehension" matchDoContextErrString MonadComp = text "monad comprehension" +instance Outputable HsDoFlavour where + ppr (DoExpr m) = text "DoExpr" <+> parens (ppr m) + ppr (MDoExpr m) = text "MDoExpr" <+> parens (ppr m) + ppr GhciStmtCtxt = text "GhciStmtCtxt" + ppr ListComp = text "ListComp" + ppr MonadComp = text "MonadComp" + pprMatchInCtxt :: (OutputableBndrId idR, Outputable body) => Match (GhcPass idR) body -> SDoc pprMatchInCtxt match = hang (text "In" <+> pprMatchContext (m_ctxt match) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -58,6 +58,7 @@ import GHC.Builtin.Names import GHC.Types.FieldLabel import GHC.Types.Fixity import GHC.Types.Id.Make +import GHC.Types.Basic(Origin(..)) import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Reader @@ -76,7 +77,7 @@ import qualified GHC.LanguageExtensions as LangExt import Language.Haskell.Syntax.Basic (FieldLabelString(..)) -import Data.List (unzip4, minimumBy) +import Data.List (unzip4, minimumBy, (\\)) import Data.List.NonEmpty ( NonEmpty(..), nonEmpty ) import Data.Maybe (isJust, isNothing) import Control.Arrow (first) @@ -432,12 +433,25 @@ rnExpr (HsDo _ do_or_lc (L l stmts)) = do { ((stmts1, _), fvs1) <- rnStmtsWithFreeVars (HsDoStmt do_or_lc) rnExpr stmts (\ _ -> return ((), emptyFVs)) - ; (pp_stmts, fvs2) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 + ; ((pp_stmts, fvs2), is_app_do) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 ; let orig_do_block = HsDo noExtField do_or_lc (L l pp_stmts) - expd_do_block = expand_do_stmts pp_stmts - ; return ( mkExpandedExpr orig_do_block expd_do_block - , fvs1 `plusFV` fvs2 ) } - + ; return $ case do_or_lc of + DoExpr {} -> (if is_app_do + -- TODO i don't want to thing about applicative stmt rearrangements yet + then orig_do_block + else let expd_do_block = expand_do_stmts do_or_lc pp_stmts + in mkExpandedExpr orig_do_block expd_do_block + , fvs1 `plusFV` fvs2 ) + MDoExpr {} -> (if is_app_do + -- TODO i don't want to thing about applicative stmt rearrangements yet + then orig_do_block + else let expd_do_block = expand_do_stmts do_or_lc pp_stmts + in mkExpandedExpr orig_do_block expd_do_block + , fvs1 `plusFV` fvs2 ) + _ -> (orig_do_block, fvs1 `plusFV` fvs2) + -- ListComp -> (orig_do_block, fvs1 `plusFV` fvs2) + -- GhciStmtCtxt -> (orig_do_block, fvs1 `plusFV` fvs2) + } -- ExplicitList: see Note [Handling overloaded and rebindable constructs] rnExpr (ExplicitList _ exps) = do { (exps', fvs) <- rnExprs exps @@ -1060,7 +1074,7 @@ rnStmts ctxt rnBody stmts thing_inside postProcessStmtsForApplicativeDo :: HsDoFlavour -> [(ExprLStmt GhcRn, FreeVars)] - -> RnM ([ExprLStmt GhcRn], FreeVars) + -> RnM (([ExprLStmt GhcRn], FreeVars), Bool) -- True <=> applicative do statement postProcessStmtsForApplicativeDo ctxt stmts = do { -- rearrange the statements using ApplicativeStmt if @@ -1074,8 +1088,10 @@ postProcessStmtsForApplicativeDo ctxt stmts ; in_th_bracket <- isBrackStage <$> getStage ; if ado_is_on && is_do_expr && not in_th_bracket then do { traceRn "ppsfa" (ppr stmts) - ; rearrangeForApplicativeDo ctxt stmts } - else noPostProcessStmts (HsDoStmt ctxt) stmts } + ; ado_stmts_and_fvs <- rearrangeForApplicativeDo ctxt stmts + ; return (ado_stmts_and_fvs, True) } + else do { do_stmts_and_fvs <- noPostProcessStmts (HsDoStmt ctxt) stmts + ; return (do_stmts_and_fvs, False) } } -- | strip the FreeVars annotations from statements noPostProcessStmts @@ -2710,51 +2726,145 @@ mkExpandedExpr a b = XExpr (HsExpanded a b) -- | Expand the Do statments so that it works fine with Quicklook -- See Note[Rebindable Do Expanding Statements] --- ANI Questions: 1. What should be the location information in the expanded expression? Currently the error is still displayed on the expanded expr and not on the unexpanded expr --- 2. Need to figure out the exact cases where this function needs to be called. It fails on lists --- 3. Convert let statements into expanded version. --- 4. hopefully the co-recursive cases won't get affected by this expansion -expand_do_stmts :: [ExprLStmt GhcRn] -> HsExpr GhcRn - -expand_do_stmts [L _ (LastStmt _ body _ NoSyntaxExprRn)] --- TODO: not sure about this maybe this never happens in a do block? --- This does happen in a list comprehension though --- = genHsApp (genHsVar returnMName) body - = unLoc body - -expand_do_stmts [L l (LastStmt _ body _ (SyntaxExprRn ret))] --- +-- ANI Questions: 1. What should be the location information in the expanded expression? Currently the error is displayed on the expanded expr and not on the unexpanded expr +expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> HsExpr GhcRn + +expand_do_stmts do_flavour [L _ (LastStmt _ body _ NoSyntaxExprRn)] + -- if it is a last statement of a list comprehension, we need to explicitly return it -- See Note [TODO] + -- genHsApp (genHsVar returnMName) body + | ListComp <- do_flavour + = genHsApp (genHsVar returnMName) body + | MonadComp <- do_flavour + = unLoc body -- genHsApp (genHsVar returnMName) body + | otherwise + -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt + = unLoc body + +expand_do_stmts _ [L _ (LastStmt _ body _ (SyntaxExprRn ret))] +-- -- ------------------------------------------------ -- return e ~~> return e -- definitely works T18324.hs - = unLoc $ mkHsApp (L l ret) body - -expand_do_stmts ((L l (BindStmt _ x e)):lstmts) + = unLoc $ mkHsApp (noLocA ret) body + +expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn x e)): lstmts) + | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn + , Just (SyntaxExprRn fail_op) <- xbsrn_failOp xbsrn = +-- the pattern binding x can fail +-- stmts ~~> stmt' let f x = stmts'; f _ = fail ".." +-- ------------------------------------------------------- +-- x <- e ; stmts ~~> (Prelude.>>=) e f + + foldl genHsApp bind_op -- (>>=) + [ e + , noLocA $ failable_expr x (expand_do_stmts do_or_lc lstmts) fail_op + ] + | SyntaxExprRn bop <- xbsrn_bindOp xbsrn + , Nothing <- xbsrn_failOp xbsrn = -- irrefutable pattern so no failure -- stmts ~~> stmt' -- ------------------------------------------------ --- x <- e ; stmts ~~> (Prelude.>>=) e (\ x -> stmts' ) - = genHsApps bindMName -- (>>=) - [ e -- e - , mkHsLam [x] (L l $ expand_do_stmts lstmts) -- (\ x -> stmts') - ] --- expand_do_stmts ((L l (LetStmt _ x e)):lstmts) = undefined +-- x <- e ; stmts ~~> (Prelude.>>=) e (\ x -> stmts') + foldl genHsApp bop -- (>>=) + [ e + , mkHsLam [x] (noLocA $ expand_do_stmts do_or_lc lstmts) -- (\ x -> stmts') + ] + + | otherwise = -- just use the polymorhpic bindop. TODO: Necessary? + genHsApps bindMName -- (Prelude.>>=) + [ e + , mkHsLam [x] (noLocA $ expand_do_stmts do_or_lc lstmts) -- (\ x -> stmts') + ] + + where + failable_expr :: LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn + failable_expr pat expr fail_op = HsLam noExtField $ + mkMatchGroup Generated + (noLocA [ mkHsCaseAlt pat (noLocA expr) + , mkHsCaseAlt nlWildPatName + (noLocA $ genHsApp fail_op + (nlHsLit $ mkHsString "fail pattern")) ]) + +expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = -- stmts ~~> stmts' -- ------------------------------------------------ -- let x = e ; stmts ~~> let x = e in stmts' + HsLet NoExtField noHsTok bnds noHsTok + $ noLocA (expand_do_stmts do_or_lc lstmts) -expand_do_stmts ((L l (BodyStmt _ e (SyntaxExprRn f) _)):lstmts) + +expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- stmts ~~> stmts' -- ---------------------------------------------- --- e ; stmts ~~> (Prelude.>>) e (\ _ -> stmt') - = unLoc $ nlHsApp (nlHsApp (L l f) -- (>>) See Note [BodyStmt] +-- e ; stmts ~~> (Prelude.>>) e stmt' + unLoc $ nlHsApp (nlHsApp (noLocA f) -- (>>) See Note [BodyStmt] e) - $ mkHsLam [] (L l $ expand_do_stmts lstmts) - --- expand_do_stmts ((L l (TransStmt {})):lstmts) = undefined --- expand_do_stmts ((L l (RecStmt {})):lstmts) = undefined - --- expand_do_stmts (stmt@(L _ (ParStmt {})):_) = pprPanic "expand_do_stmts: impossible happened" $ ppr stmt -expand_do_stmts stmt = pprPanic "expand_do_stmts: impossible happened" $ ppr stmt + $ (noLocA $ expand_do_stmts do_or_lc lstmts) + +expand_do_stmts do_or_lc ((L l (RecStmt { recS_stmts = rec_stmts + , recS_later_ids = later_ids -- forward referenced local ids + , recS_rec_ids = local_ids -- ids referenced outside of the rec block + , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr + , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr + -- use it explicitly + -- at the end of expanded rec block + })) + : lstmts) = +-- See Note [Typing a RecStmt] +-- stmts ~~> stmts' +-- ------------------------------------------------------------------------------------------- +-- rec { later_ids, local_ids, rec_block } ; stmts +-- ~~> (Prelude.>>=) (mfix (\[ local_ids ++ later_ids ] +-- -> do { rec_stmts +-- ; return (later_ids, local_ids) } )) +-- (\ [ local_ids ++ later_ids ] -> stmts') + + genHsApps bindMName -- (Prelude.>>=) + [ (noLocA mfix_fun) `mkHsApp` mfix_expr -- mfix (do block) + , mkHsLam [ mkBigLHsVarPatTup all_ids ] -- (\ x -> stmts') + (L l $ expand_do_stmts do_or_lc lstmts) + ] + where + local_only_ids = local_ids \\ later_ids -- get unique local rec ids; local rec ids and later ids overlap + all_ids = local_only_ids ++ later_ids -- put local ids before return ids + + return_stmt :: ExprLStmt GhcRn + return_stmt = noLocA $ LastStmt noExtField + (mkHsApp (noLocA return_fun) + $ mkBigLHsTup (map nlHsVar all_ids) noExtField) + Nothing + (SyntaxExprRn return_fun) + do_stmts :: XRec GhcRn [ExprLStmt GhcRn] + do_stmts = noLocA $ (unLoc rec_stmts) ++ [return_stmt] + do_block :: LHsExpr GhcRn + do_block = noLocA $ HsDo noExtField (DoExpr Nothing) $ do_stmts + mfix_expr :: LHsExpr GhcRn + mfix_expr = mkHsLam [ mkBigLHsVarPatTup all_ids ] $ do_block + +expand_do_stmts _ (stmt@(L _ (RecStmt {})):_) = + pprPanic "expand_do_stmts: impossible happened RecStmt" $ ppr stmt + + +expand_do_stmts _ (stmt@(L _ (TransStmt {})):_) = + pprPanic "expand_do_stmts: impossible happened TransStmt" $ ppr stmt + +expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = +-- See See Note [Monad Comprehensions] +-- Parallel statements only appear in +-- stmts ~~> stmts' +-- ------------------------------------------------------------------------------------------- +-- ; stmts +-- ~~> (Prelude.>>=) (mfix (\[ local_ids ++ later_ids ] +-- -> do { rec_stmts +-- ; return (later_ids, local_ids) } )) +-- (\ [ local_ids ++ later_ids ] -> stmts') + pprPanic "expand_do_stmts: impossible happened ParStmt" $ ppr stmt + +expand_do_stmts _ (stmt@(L _ (ApplicativeStmt {})):_) = +-- See Note [Applicative BodyStmt] + + pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" $ ppr stmt + +expand_do_stmts do_flavor stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr do_flavor $$ ppr stmts) ----------------------------------------- -- Bits and pieces for RecordDotSyntax. ===================================== testsuite/tests/rebindable/T18324.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE ImpredicativeTypes, DeriveAnyClass #-} -module T18324 where +-- {-# LANGUAGE MonadComprehensions, RecursiveDo #-} +module Main where type Id = forall a. a -> a @@ -15,14 +16,6 @@ foo1 = t >>= \x -> return (p x) foo2 = do { x <- t ; return (p x) } --- data State a s = S (a, s) deriving (Functor, Applicative, Monad) - --- update :: State a s -> (s -> s) -> State a s --- update (S (a, s)) f = S (a, f s) - - --- ts :: State Int Id --- ts = return id - --- foo3 = do { x <- ts ; update ts ; return (p x) } - +main = do x <- foo2 + putStrLn $ show x + ===================================== testsuite/tests/rebindable/all.T ===================================== @@ -42,3 +42,5 @@ test('T14670', expect_broken(14670), compile, ['']) test('T19167', normal, compile, ['']) test('T19918', normal, compile_and_run, ['']) test('T20126', normal, compile_fail, ['']) +test('T18324', normal, compile_and_run, ['']) +test('pattern-fails', normal, compile_and_run, ['']) ===================================== testsuite/tests/rebindable/pattern-fails.hs ===================================== @@ -0,0 +1,9 @@ +module Main where + + +main :: IO () +main = putStrLn . show $ qqq ['c'] + +qqq :: [a] -> Maybe (a, [a]) +qqq ts = do { (a:b:as) <- Just ts + ; return (a, as) } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a18899588f4480a0cdb50cf5d5b78fc92123f8e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a18899588f4480a0cdb50cf5d5b78fc92123f8e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 17 23:32:02 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 17 Mar 2023 19:32:02 -0400 Subject: [Git][ghc/ghc][wip/expand-do] HsExpand for HsDo Message-ID: <6414f8727d0a1_20ac84f78e6b4242316@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 9f5b7424 by Apoorv Ingle at 2023-03-17T18:30:59-05:00 HsExpand for HsDo Fixes for #18324 - fixed rec do blocks to use mfix - make sure fail is used for pattern match failures in bind statments - - - - - 5 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - + testsuite/tests/rebindable/T18324.hs - testsuite/tests/rebindable/all.T - + testsuite/tests/rebindable/pattern-fails.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1055,11 +1055,12 @@ data HsExpansion orig expanded = HsExpanded orig expanded deriving Data --- | Just print the original expression (the @a@). +-- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - (ppr orig) + -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + -- (ppr orig) + = ppr orig <+> braces (text "Expansion:" <+> ppr expanded) {- @@ -1961,6 +1962,13 @@ matchDoContextErrString (MDoExpr m) = prependQualified m (text "'mdo' block") matchDoContextErrString ListComp = text "list comprehension" matchDoContextErrString MonadComp = text "monad comprehension" +instance Outputable HsDoFlavour where + ppr (DoExpr m) = text "DoExpr" <+> parens (ppr m) + ppr (MDoExpr m) = text "MDoExpr" <+> parens (ppr m) + ppr GhciStmtCtxt = text "GhciStmtCtxt" + ppr ListComp = text "ListComp" + ppr MonadComp = text "MonadComp" + pprMatchInCtxt :: (OutputableBndrId idR, Outputable body) => Match (GhcPass idR) body -> SDoc pprMatchInCtxt match = hang (text "In" <+> pprMatchContext (m_ctxt match) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -58,6 +58,7 @@ import GHC.Builtin.Names import GHC.Types.FieldLabel import GHC.Types.Fixity import GHC.Types.Id.Make +import GHC.Types.Basic(Origin(..)) import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Reader @@ -76,7 +77,7 @@ import qualified GHC.LanguageExtensions as LangExt import Language.Haskell.Syntax.Basic (FieldLabelString(..)) -import Data.List (unzip4, minimumBy) +import Data.List (unzip4, minimumBy, (\\)) import Data.List.NonEmpty ( NonEmpty(..), nonEmpty ) import Data.Maybe (isJust, isNothing) import Control.Arrow (first) @@ -432,9 +433,25 @@ rnExpr (HsDo _ do_or_lc (L l stmts)) = do { ((stmts1, _), fvs1) <- rnStmtsWithFreeVars (HsDoStmt do_or_lc) rnExpr stmts (\ _ -> return ((), emptyFVs)) - ; (pp_stmts, fvs2) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 - ; return ( HsDo noExtField do_or_lc (L l pp_stmts), fvs1 `plusFV` fvs2 ) } - + ; ((pp_stmts, fvs2), is_app_do) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 + ; let orig_do_block = HsDo noExtField do_or_lc (L l pp_stmts) + ; return $ case do_or_lc of + DoExpr {} -> (if is_app_do + -- TODO i don't want to thing about applicative stmt rearrangements yet + then orig_do_block + else let expd_do_block = expand_do_stmts do_or_lc pp_stmts + in mkExpandedExpr orig_do_block expd_do_block + , fvs1 `plusFV` fvs2 ) + MDoExpr {} -> (if is_app_do + -- TODO i don't want to thing about applicative stmt rearrangements yet + then orig_do_block + else let expd_do_block = expand_do_stmts do_or_lc pp_stmts + in mkExpandedExpr orig_do_block expd_do_block + , fvs1 `plusFV` fvs2 ) + _ -> (orig_do_block, fvs1 `plusFV` fvs2) + -- ListComp -> (orig_do_block, fvs1 `plusFV` fvs2) + -- GhciStmtCtxt -> (orig_do_block, fvs1 `plusFV` fvs2) + } -- ExplicitList: see Note [Handling overloaded and rebindable constructs] rnExpr (ExplicitList _ exps) = do { (exps', fvs) <- rnExprs exps @@ -1057,7 +1074,7 @@ rnStmts ctxt rnBody stmts thing_inside postProcessStmtsForApplicativeDo :: HsDoFlavour -> [(ExprLStmt GhcRn, FreeVars)] - -> RnM ([ExprLStmt GhcRn], FreeVars) + -> RnM (([ExprLStmt GhcRn], FreeVars), Bool) -- True <=> applicative do statement postProcessStmtsForApplicativeDo ctxt stmts = do { -- rearrange the statements using ApplicativeStmt if @@ -1071,8 +1088,10 @@ postProcessStmtsForApplicativeDo ctxt stmts ; in_th_bracket <- isBrackStage <$> getStage ; if ado_is_on && is_do_expr && not in_th_bracket then do { traceRn "ppsfa" (ppr stmts) - ; rearrangeForApplicativeDo ctxt stmts } - else noPostProcessStmts (HsDoStmt ctxt) stmts } + ; ado_stmts_and_fvs <- rearrangeForApplicativeDo ctxt stmts + ; return (ado_stmts_and_fvs, True) } + else do { do_stmts_and_fvs <- noPostProcessStmts (HsDoStmt ctxt) stmts + ; return (do_stmts_and_fvs, False) } } -- | strip the FreeVars annotations from statements noPostProcessStmts @@ -1165,7 +1184,7 @@ rnStmt ctxt rnBody (L loc (LastStmt _ (L lb body) noret _)) thing_inside else return (noSyntaxExpr, emptyFVs) -- The 'return' in a LastStmt is used only -- for MonadComp; and we don't want to report - -- "non in scope: return" in other cases + -- "not in scope: return" in other cases -- #15607 ; (thing, fvs3) <- thing_inside [] @@ -2703,6 +2722,150 @@ mkExpandedExpr -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedExpr a b = XExpr (HsExpanded a b) + + +-- | Expand the Do statments so that it works fine with Quicklook +-- See Note[Rebindable Do Expanding Statements] +-- ANI Questions: 1. What should be the location information in the expanded expression? Currently the error is displayed on the expanded expr and not on the unexpanded expr +expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> HsExpr GhcRn + +expand_do_stmts do_flavour [L _ (LastStmt _ body _ NoSyntaxExprRn)] + -- if it is a last statement of a list comprehension, we need to explicitly return it -- See Note [TODO] + -- genHsApp (genHsVar returnMName) body + | ListComp <- do_flavour + = genHsApp (genHsVar returnMName) body + | MonadComp <- do_flavour + = unLoc body -- genHsApp (genHsVar returnMName) body + | otherwise + -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt + = unLoc body + +expand_do_stmts _ [L _ (LastStmt _ body _ (SyntaxExprRn ret))] +-- +-- ------------------------------------------------ +-- return e ~~> return e +-- definitely works T18324.hs + = unLoc $ mkHsApp (noLocA ret) body + +expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn x e)): lstmts) + | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn + , Just (SyntaxExprRn fail_op) <- xbsrn_failOp xbsrn = +-- the pattern binding x can fail +-- stmts ~~> stmt' let f x = stmts'; f _ = fail ".." +-- ------------------------------------------------------- +-- x <- e ; stmts ~~> (Prelude.>>=) e f + + foldl genHsApp bind_op -- (>>=) + [ e + , noLocA $ failable_expr x (expand_do_stmts do_or_lc lstmts) fail_op + ] + | SyntaxExprRn bop <- xbsrn_bindOp xbsrn + , Nothing <- xbsrn_failOp xbsrn = -- irrefutable pattern so no failure +-- stmts ~~> stmt' +-- ------------------------------------------------ +-- x <- e ; stmts ~~> (Prelude.>>=) e (\ x -> stmts') + foldl genHsApp bop -- (>>=) + [ e + , mkHsLam [x] (noLocA $ expand_do_stmts do_or_lc lstmts) -- (\ x -> stmts') + ] + + | otherwise = -- just use the polymorhpic bindop. TODO: Necessary? + genHsApps bindMName -- (Prelude.>>=) + [ e + , mkHsLam [x] (noLocA $ expand_do_stmts do_or_lc lstmts) -- (\ x -> stmts') + ] + + where + failable_expr :: LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn + failable_expr pat expr fail_op = HsLam noExtField $ + mkMatchGroup Generated + (noLocA [ mkHsCaseAlt pat (noLocA expr) + , mkHsCaseAlt nlWildPatName + (noLocA $ genHsApp fail_op + (nlHsLit $ mkHsString "fail pattern")) ]) + +expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = +-- stmts ~~> stmts' +-- ------------------------------------------------ +-- let x = e ; stmts ~~> let x = e in stmts' + HsLet NoExtField noHsTok bnds noHsTok + $ noLocA (expand_do_stmts do_or_lc lstmts) + + +expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = +-- stmts ~~> stmts' +-- ---------------------------------------------- +-- e ; stmts ~~> (Prelude.>>) e stmt' + unLoc $ nlHsApp (nlHsApp (noLocA f) -- (>>) See Note [BodyStmt] + e) + $ (noLocA $ expand_do_stmts do_or_lc lstmts) + +expand_do_stmts do_or_lc ((L l (RecStmt { recS_stmts = rec_stmts + , recS_later_ids = later_ids -- forward referenced local ids + , recS_rec_ids = local_ids -- ids referenced outside of the rec block + , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr + , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr + -- use it explicitly + -- at the end of expanded rec block + })) + : lstmts) = +-- See Note [Typing a RecStmt] +-- stmts ~~> stmts' +-- ------------------------------------------------------------------------------------------- +-- rec { later_ids, local_ids, rec_block } ; stmts +-- ~~> (Prelude.>>=) (mfix (\[ local_ids ++ later_ids ] +-- -> do { rec_stmts +-- ; return (later_ids, local_ids) } )) +-- (\ [ local_ids ++ later_ids ] -> stmts') + + genHsApps bindMName -- (Prelude.>>=) + [ (noLocA mfix_fun) `mkHsApp` mfix_expr -- mfix (do block) + , mkHsLam [ mkBigLHsVarPatTup all_ids ] -- (\ x -> stmts') + (L l $ expand_do_stmts do_or_lc lstmts) + ] + where + local_only_ids = local_ids \\ later_ids -- get unique local rec ids; local rec ids and later ids overlap + all_ids = local_only_ids ++ later_ids -- put local ids before return ids + + return_stmt :: ExprLStmt GhcRn + return_stmt = noLocA $ LastStmt noExtField + (mkHsApp (noLocA return_fun) + $ mkBigLHsTup (map nlHsVar all_ids) noExtField) + Nothing + (SyntaxExprRn return_fun) + do_stmts :: XRec GhcRn [ExprLStmt GhcRn] + do_stmts = noLocA $ (unLoc rec_stmts) ++ [return_stmt] + do_block :: LHsExpr GhcRn + do_block = noLocA $ HsDo noExtField (DoExpr Nothing) $ do_stmts + mfix_expr :: LHsExpr GhcRn + mfix_expr = mkHsLam [ mkBigLHsVarPatTup all_ids ] $ do_block + +expand_do_stmts _ (stmt@(L _ (RecStmt {})):_) = + pprPanic "expand_do_stmts: impossible happened RecStmt" $ ppr stmt + + +expand_do_stmts _ (stmt@(L _ (TransStmt {})):_) = + pprPanic "expand_do_stmts: impossible happened TransStmt" $ ppr stmt + +expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = +-- See See Note [Monad Comprehensions] +-- Parallel statements only appear in +-- stmts ~~> stmts' +-- ------------------------------------------------------------------------------------------- +-- ; stmts +-- ~~> (Prelude.>>=) (mfix (\[ local_ids ++ later_ids ] +-- -> do { rec_stmts +-- ; return (later_ids, local_ids) } )) +-- (\ [ local_ids ++ later_ids ] -> stmts') + pprPanic "expand_do_stmts: impossible happened ParStmt" $ ppr stmt + +expand_do_stmts _ (stmt@(L _ (ApplicativeStmt {})):_) = +-- See Note [Applicative BodyStmt] + + pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" $ ppr stmt + +expand_do_stmts do_flavor stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr do_flavor $$ ppr stmts) + ----------------------------------------- -- Bits and pieces for RecordDotSyntax. -- ===================================== testsuite/tests/rebindable/T18324.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE ImpredicativeTypes, DeriveAnyClass #-} +-- {-# LANGUAGE MonadComprehensions, RecursiveDo #-} +module Main where + + +type Id = forall a. a -> a + +t :: IO Id +t = return id + +p :: Id -> (Bool, Int) +p f = (f True, f 3) + +foo1 = t >>= \x -> return (p x) + +foo2 = do { x <- t ; return (p x) } + + +main = do x <- foo2 + putStrLn $ show x + ===================================== testsuite/tests/rebindable/all.T ===================================== @@ -42,3 +42,5 @@ test('T14670', expect_broken(14670), compile, ['']) test('T19167', normal, compile, ['']) test('T19918', normal, compile_and_run, ['']) test('T20126', normal, compile_fail, ['']) +test('T18324', normal, compile_and_run, ['']) +test('pattern-fails', normal, compile_and_run, ['']) ===================================== testsuite/tests/rebindable/pattern-fails.hs ===================================== @@ -0,0 +1,9 @@ +module Main where + + +main :: IO () +main = putStrLn . show $ qqq ['c'] + +qqq :: [a] -> Maybe (a, [a]) +qqq ts = do { (a:b:as) <- Just ts + ; return (a, as) } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f5b74243c8c21ee5fab4f0c06deef5c5913a0bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f5b74243c8c21ee5fab4f0c06deef5c5913a0bf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 18 00:02:21 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 17 Mar 2023 20:02:21 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] More wibbles, prompted by talking with Richard Message-ID: <6414ff8dbbb8f_20ac84100a88f8243072@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 6d0330f2 by Simon Peyton Jones at 2023-03-18T00:03:40+00:00 More wibbles, prompted by talking with Richard - - - - - 6 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -2002,6 +2002,10 @@ isInjectiveTyCon (TyCon { tyConDetails = details }) role -- (where r is the role passed in): -- If (T tys ~r t), then (t's head ~r T). -- See also Note [Decomposing TyConApp equalities] in "GHC.Tc.Solver.Canonical" +-- +-- NB: at Nominal role, isGenerativeTyCon is simple: +-- isGenerativeTyCon tc Nominal +-- = not (isTypeFamilyTyCon tc || isSynonymTyCon tc) isGenerativeTyCon :: TyCon -> Role -> Bool isGenerativeTyCon tc@(TyCon { tyConDetails = details }) role = go role details ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1534,7 +1534,8 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco | TyVarLHS tv1 <- lhs1 , TyVarLHS tv2 <- lhs2 - = do { traceTcS "canEqLHS2 swapOver" (ppr tv1 $$ ppr tv2 $$ ppr swapped) + = -- See Note [TyVar/TyVar orientation] in GHC.Tc.Utils.Unify + do { traceTcS "canEqLHS2 swapOver" (ppr tv1 $$ ppr tv2 $$ ppr swapped) ; if swapOverTyVars (isGiven ev) tv1 tv2 then finish_with_swapping else finish_without_swapping } @@ -1600,36 +1601,24 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco tvs2 = tyCoVarsOfTypes fun_args2 swap_for_rewriting = anyVarSet (isTouchableMetaTyVar tclvl) tvs2 && - -- swap 'em: Note [Put touchable variables on the left] + -- See Note [Put touchable variables on the left] not (anyVarSet (isTouchableMetaTyVar tclvl) tvs1) - -- this check is just to avoid unfruitful swapping - - swap_for_occurs = False - -{- ToDo: not sure about this - -- If we have F a ~ F (F a), we want to swap. - swap_for_occurs - | cterHasNoProblem $ checkTyFamEq fun_tc2 fun_args2 - (mkTyConApp fun_tc1 fun_args1) - , cterHasOccursCheck $ checkTyFamEq fun_tc1 fun_args1 - (mkTyConApp fun_tc2 fun_args2) - = True - | otherwise - = False --} + -- This second check is just to avoid unfruitful swapping - ; if swap_for_rewriting || swap_for_occurs + ; if swap_for_rewriting then finish_with_swapping else finish_without_swapping } where sym_mco = mkSymMCo mco - finish_without_swapping - = canEqCanLHSFinish ev eq_rel swapped lhs1 (ps_xi2 `mkCastTyMCo` mco) - finish_with_swapping - = do { new_ev <- rewriteCastedEquality ev eq_rel swapped - (canEqLHSType lhs1) (canEqLHSType lhs2) mco - ; canEqCanLHSFinish new_ev eq_rel IsSwapped lhs2 (ps_xi1 `mkCastTyMCo` sym_mco) } + finish_without_swapping = canEqCanLHSFinish ev eq_rel swapped + lhs1 (ps_xi2 `mkCastTyMCo` mco) + finish_with_swapping = canEqCanLHSFinish ev eq_rel (flipSwap swapped) + lhs2 (ps_xi1 `mkCastTyMCo` sym_mco) + +-- = do { new_ev <- rewriteCastedEquality ev eq_rel swapped +-- (canEqLHSType lhs1) (canEqLHSType lhs2) mco +-- ; canEqCanLHSFinish new_ev eq_rel IsSwapped lhs2 (ps_xi1 `mkCastTyMCo` sym_mco) } put_tyvar_on_lhs = isWanted ev && eq_rel == NomEq -- See Note [Orienting TyVarLHS/TyFamLHS] @@ -1713,7 +1702,7 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs = do { given_eq_lvl <- getInnermostGivenEqLevel ; if not (touchabilityAndShapeTest given_eq_lvl tv rhs) then if | Just can_rhs <- canTyFamEqLHS_maybe rhs - -> swapAndFinish ev eq_rel swapped tv can_rhs + -> swapAndFinish ev eq_rel swapped (mkTyVarTy tv) can_rhs -- See Note [Orienting TyVarLHS/TyFamLHS] | otherwise @@ -1724,23 +1713,28 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs do { check_result <- checkTouchableTyVarEq ev tv rhs ; case check_result of { PuFail reason - | Just can_rhs <- canTyFamEqLHS_maybe rhs - -> swapAndFinish ev eq_rel swapped tv can_rhs - -- See Note [Orienting TyVarLHS/TyFamLHS] + | Just can_rhs <- canTyFamEqLHS_maybe rhs + -> swapAndFinish ev eq_rel swapped (mkTyVarTy tv) can_rhs + -- See Note [Orienting TyVarLHS/TyFamLHS] - -- If we have [W] alpha[2] ~ Maybe b[3] - -- we can't unify (skolem-escape); but it /is/ canonical, - -- and hence we /can/ use it for rewriting - | reason `cterHasOnlyProblem` cteSkolemEscape - -> canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs + -- If we have [W] alpha[2] ~ Maybe b[3] + -- we can't unify (skolem-escape); but it /is/ canonical, + -- and hence we /can/ use it for rewriting + | reason `cterHasOnlyProblem` cteSkolemEscape + -> canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs - | otherwise - -> tryIrredInstead reason ev eq_rel swapped lhs rhs ; + | otherwise + -> tryIrredInstead reason ev eq_rel swapped lhs rhs ; PuOK rhs_redn _ -> -- Success: we can solve by unification - do { -- Comment needed! + do { -- In the common case where rhs_redn is Refl, we don't need to rewrite + -- the evidence even if swapped=IsSwapped. Suppose the original was + -- [W] co : Int ~ alpha + -- We unify alpha := Int, and set co := . No need to + -- swap to co = sym co' + -- co' = new_ev <- if isReflCo (reductionCoercion rhs_redn) then return ev else rewriteEqEvidence emptyRewriterSet ev swapped @@ -1787,27 +1781,38 @@ canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs -- in case have x ~ (y :: ..x...); this is #12593. ; check_result <- checkTypeEq ev eq_rel lhs rhs - ; case check_result of { - PuFail reason -> tryIrredInstead reason ev eq_rel swapped lhs rhs ; - PuOK rhs_redn _ -> + ; let lhs_ty = canEqLHSType lhs + ; case check_result of + PuFail reason - do { new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped - (mkReflRedn Nominal (canEqLHSType lhs)) rhs_redn + -- If we had F a ~ G (F a), which gives an occurs check, + -- then swap it to G (F a) ~ F a, which does not + | TyFamLHS {} <- lhs + , Just can_rhs <- canTyFamEqLHS_maybe rhs + , reason `cterHasOnlyProblem` cteSolubleOccurs + -> swapAndFinish ev eq_rel swapped lhs_ty can_rhs - ; interactEq (EqCt { eq_ev = new_ev, eq_eq_rel = eq_rel - , eq_lhs = lhs - , eq_rhs = reductionReducedType rhs_redn }) }}} + | otherwise + -> tryIrredInstead reason ev eq_rel swapped lhs rhs + + PuOK rhs_redn _ + -> do { new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped + (mkReflRedn (eqRelRole eq_rel) lhs_ty) + rhs_redn + + ; interactEq (EqCt { eq_ev = new_ev, eq_eq_rel = eq_rel + , eq_lhs = lhs + , eq_rhs = reductionReducedType rhs_redn }) } } ---------------------- swapAndFinish :: CtEvidence -> EqRel -> SwapFlag - -> TcTyVar -> CanEqLHS -- a ~ F tys + -> TcType -> CanEqLHS -- ty ~ F tys -> TcS (StopOrContinue Ct) -- We have an equality alpha ~ F tys, that we can't unify e.g because 'tys' -- mentions alpha, it would not be a canonical constraint as-is. -- We want to flip it to (F tys ~ a), whereupon it is canonical -swapAndFinish ev eq_rel swapped lhs_tv can_rhs - = do { let lhs_ty = mkTyVarTy lhs_tv - ; new_ev <- rewriteEqEvidence emptyRewriterSet ev (flipSwap swapped) +swapAndFinish ev eq_rel swapped lhs_ty can_rhs + = do { new_ev <- rewriteEqEvidence emptyRewriterSet ev (flipSwap swapped) (mkReflRedn role (canEqLHSType can_rhs)) (mkReflRedn role lhs_ty) ; interactEq (EqCt { eq_ev = new_ev, eq_eq_rel = eq_rel @@ -2302,6 +2307,7 @@ Details: ********************************************************************** -} +{- rewriteCastedEquality :: CtEvidence -- :: lhs ~ (rhs |> mco), or (rhs |> mco) ~ lhs -> EqRel -> SwapFlag -> TcType -- lhs @@ -2317,6 +2323,7 @@ rewriteCastedEquality ev eq_rel swapped lhs rhs mco sym_mco = mkSymMCo mco role = eqRelRole eq_rel +-} rewriteEqEvidence :: RewriterSet -- New rewriters -- See GHC.Tc.Types.Constraint ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -2100,7 +2100,7 @@ checkTouchableTyVarEq ev lhs_tv rhs flags | MetaTv { mtv_info = tv_info, mtv_tclvl = tv_lvl } <- tcTyVarDetails lhs_tv = TEF { tef_foralls = isRuntimeUnkSkol lhs_tv - , tef_fam_app = mkTEFA_Break ev (break_wanted tv_lvl) + , tef_fam_app = mkTEFA_Break ev (break_wanted tv_info tv_lvl) , tef_unifying = Unifying tv_info tv_lvl LC_Promote , tef_lhs = TyVarLHS lhs_tv , tef_occurs = cteInsolubleOccurs } @@ -2108,8 +2108,22 @@ checkTouchableTyVarEq ev lhs_tv rhs arg_flags = famAppArgFlags flags - break_wanted lhs_tv_lvl fam_app -- Occurs check or skolem escape; so flatten - = do { new_tv_ty <- TcM.newMetaTyVarTyAtLevel lhs_tv_lvl (typeKind fam_app) + break_wanted lhs_tv_info lhs_tv_lvl fam_app + -- Occurs check or skolem escape; so flatten + = do { let fam_app_kind = typeKind fam_app + ; reason <- checkPromoteFreeVars cteInsolubleOccurs + lhs_tv lhs_tv_lvl (tyCoVarsOfType fam_app_kind) + ; if not (cterHasNoProblem reason) -- Failed to promote free vars + then failCheckWith reason + else + do { let tv_info | isConcreteInfo lhs_tv_info = lhs_tv_info + | otherwise = TauTv + -- Make a concrete tyvar if lhs_tv is concrete + -- e.g. alpha[2,conc] ~ Maybe (F beta[4]) + -- We want to flatten to + -- alpha[2,conc] ~ Maybe gamma[2,conc] + -- gamma[2,conc] ~ F beta[4] + ; new_tv_ty <- TcM.newMetaTyVarTyWithInfo lhs_tv_lvl tv_info fam_app_kind ; let pty = mkPrimEqPredRole Nominal fam_app new_tv_ty ; hole <- TcM.newCoercionHole pty ; let new_ev = CtWanted { ctev_pred = pty @@ -2117,7 +2131,7 @@ checkTouchableTyVarEq ev lhs_tv rhs , ctev_loc = cb_loc , ctev_rewriters = ctEvRewriters ev } ; return (PuOK (mkReduction (HoleCo hole) new_tv_ty) - (singleCt (mkNonCanonical new_ev))) } + (singleCt (mkNonCanonical new_ev))) } } -- See Detail (7) of the Note cb_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -279,12 +279,11 @@ An EqCt is a canonical equality constraint. It satisfies these invariants: See Note [No top-level newtypes on RHS of representational equalities] in GHC.Tc.Solver.Canonical. (Applies only when constructor of newtype is in scope.) - * (TyEq:TV) If rhs (perhaps under a cast) is also CanEqLHS, then it is oriented - to give best chance of unification happening; eg if rhs is touchable then lhs is too - Note [TyVar/TyVar orientation] in GHC.Tc.Utils.Unify + * (TyEq:U) An EqCt is not immediately unifiable. If we can unify a:=ty, we + will not form an EqCt (a ~ ty). -These invariants ensure that the EqCts in inert_eqs constitute a -terminating generalised substitution. See Note [inert_eqs: the inert equalities] +These invariants ensure that the EqCts in inert_eqs constitute a terminating +generalised substitution. See Note [inert_eqs: the inert equalities] in GHC.Tc.Solver.InertSet for what these words mean! -} ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -23,7 +23,8 @@ module GHC.Tc.Utils.TcMType ( newFlexiTyVarTys, -- Int -> Kind -> TcM [TcType] newOpenFlexiTyVar, newOpenFlexiTyVarTy, newOpenTypeKind, newOpenBoxedTypeKind, - newMetaKindVar, newMetaKindVars, newMetaTyVarTyAtLevel, + newMetaKindVar, newMetaKindVars, + newMetaTyVarTyAtLevel, newMetaTyVarTyWithInfo, newAnonMetaTyVar, newConcreteTyVar, cloneMetaTyVar, cloneMetaTyVarWithInfo, newCycleBreakerTyVar, @@ -1131,6 +1132,15 @@ newMetaTyVarTyAtLevel tc_lvl kind ; name <- newMetaTyVarName (fsLit "p") ; return (mkTyVarTy (mkTcTyVar name kind details)) } +newMetaTyVarTyWithInfo :: TcLevel -> MetaInfo -> TcKind -> TcM TcType +newMetaTyVarTyWithInfo tc_lvl info kind + = do { ref <- newMutVar Flexi + ; let details = MetaTv { mtv_info = info + , mtv_ref = ref + , mtv_tclvl = tc_lvl } + ; name <- newMetaTyVarName (fsLit "p") + ; return (mkTyVarTy (mkTcTyVar name kind details)) } + {- ********************************************************************* * * Finding variables to quantify over ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -36,7 +36,7 @@ module GHC.Tc.Utils.Unify ( checkTyEqRhs, PuResult(..), failCheckWith, okCheckRefl, mapCheck, TyEqFlags(..), TyEqFamApp(..), AreUnifying(..), LevelCheck(..), FamAppBreaker, - famAppArgFlags, occursCheckTv, simpleUnifyCheck + famAppArgFlags, occursCheckTv, simpleUnifyCheck, checkPromoteFreeVars ) where import GHC.Prelude @@ -2593,6 +2593,7 @@ simpleUnifyCheck fam_ok lhs_tv rhs go (LitTy {}) = True go_co co = not (lhs_tv `elemVarSet` tyCoVarsOfCo co) + && not (hasCoercionHoleCo co) {- ********************************************************************* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d0330f20b6b0688e6d4a961fb7a39ce62d61207 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d0330f20b6b0688e6d4a961fb7a39ce62d61207 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 18 23:25:17 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 18 Mar 2023 19:25:17 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] More wibbles Message-ID: <6416485dd6456_20ac8429b70d942873ee@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: bbba89ea by Simon Peyton Jones at 2023-03-18T23:26:41+00:00 More wibbles - - - - - 11 changed files: - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/polykinds/T18451a.hs - testsuite/tests/polykinds/T22793.stderr - testsuite/tests/polykinds/all.T - testsuite/tests/typecheck/no_skolem_info/T14040.stderr - testsuite/tests/typecheck/should_compile/PolytypeDecomp.stderr - testsuite/tests/typecheck/should_compile/T13651.stderr - testsuite/tests/typecheck/should_fail/tcfail097.stderr Changes: ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1602,8 +1602,9 @@ mkEqErr_help :: SolverReportErrCtxt mkEqErr_help ctxt item ty1 ty2 | Just casted_tv1 <- getCastedTyVar_maybe ty1 = mkTyVarEqErr ctxt item casted_tv1 ty2 - | Just casted_tv2 <- getCastedTyVar_maybe ty2 - = mkTyVarEqErr ctxt item casted_tv2 ty1 +-- ToDo: explain.. Cf T2627b +-- | Just casted_tv2 <- getCastedTyVar_maybe ty2 +-- = mkTyVarEqErr ctxt item casted_tv2 ty1 | otherwise = do { err <- reportEqErr ctxt item ty1 ty2 ; return (err, noHints) } ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1530,7 +1530,7 @@ canEqCanLHS2 :: CtEvidence -- lhs ~ (rhs |> mco) canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco | lhs1 `eqCanEqLHS` lhs2 -- It must be the case that mco is reflexive - = canEqReflexive ev eq_rel (canEqLHSType lhs1) + = canEqReflexive ev eq_rel lhs1_ty | TyVarLHS tv1 <- lhs1 , TyVarLHS tv2 <- lhs2 @@ -1610,15 +1610,23 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco else finish_without_swapping } where sym_mco = mkSymMCo mco - - finish_without_swapping = canEqCanLHSFinish ev eq_rel swapped - lhs1 (ps_xi2 `mkCastTyMCo` mco) - finish_with_swapping = canEqCanLHSFinish ev eq_rel (flipSwap swapped) - lhs2 (ps_xi1 `mkCastTyMCo` sym_mco) - --- = do { new_ev <- rewriteCastedEquality ev eq_rel swapped --- (canEqLHSType lhs1) (canEqLHSType lhs2) mco --- ; canEqCanLHSFinish new_ev eq_rel IsSwapped lhs2 (ps_xi1 `mkCastTyMCo` sym_mco) } + role = eqRelRole eq_rel + lhs1_ty = canEqLHSType lhs1 + lhs2_ty = canEqLHSType lhs2 + + finish_without_swapping + = canEqCanLHSFinish ev eq_rel swapped lhs1 (ps_xi2 `mkCastTyMCo` mco) + + -- Swapping. We have ev : lhs1 ~ lhs2 |> co + -- We swap to new_ev : lhs2 ~ lhs1 |> sym co + -- ev = grefl1 ; sym new_ev ; grefl2 + -- where grefl1 : lhs1 ~ lhs1 |> sym co + -- grefl2 : lhs2 ~ lhs2 |> co + finish_with_swapping + = do { let lhs1_redn = mkGReflRightMRedn role lhs1_ty sym_mco + lhs2_redn = mkGReflLeftMRedn role lhs2_ty mco + ; new_ev <-rewriteEqEvidence emptyRewriterSet ev swapped lhs1_redn lhs2_redn + ; canEqCanLHSFinish new_ev eq_rel IsSwapped lhs2 (ps_xi1 `mkCastTyMCo` sym_mco) } put_tyvar_on_lhs = isWanted ev && eq_rel == NomEq -- See Note [Orienting TyVarLHS/TyFamLHS] @@ -1717,10 +1725,7 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs -> swapAndFinish ev eq_rel swapped (mkTyVarTy tv) can_rhs -- See Note [Orienting TyVarLHS/TyFamLHS] - -- If we have [W] alpha[2] ~ Maybe b[3] - -- we can't unify (skolem-escape); but it /is/ canonical, - -- and hence we /can/ use it for rewriting - | reason `cterHasOnlyProblem` cteSkolemEscape + | reason `cterHasOnlyProblems` do_not_prevent_rewriting -> canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs | otherwise @@ -1773,6 +1778,17 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs | otherwise = canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs + where + -- Some problems prevent /unification/ but not /rewriting/ + -- Skolem-escape: if we have [W] alpha[2] ~ Maybe b[3] + -- we can't unify (skolem-escape); but it /is/ canonical, + -- and hence we /can/ use it for rewriting + -- Concrete-ness: alpha[conc] ~ b[sk] + -- We can use it to rewrite; we still have to solve the original + do_not_prevent_rewriting :: CheckTyEqResult + do_not_prevent_rewriting = cteProblem cteSkolemEscape S.<> + cteProblem cteConcrete + --------------------------- -- Unification is off the table canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs @@ -2307,24 +2323,6 @@ Details: ********************************************************************** -} -{- -rewriteCastedEquality :: CtEvidence -- :: lhs ~ (rhs |> mco), or (rhs |> mco) ~ lhs - -> EqRel -> SwapFlag - -> TcType -- lhs - -> TcType -- rhs - -> MCoercion -- mco - -> TcS CtEvidence -- :: (lhs |> sym mco) ~ rhs - -- result is independent of SwapFlag -rewriteCastedEquality ev eq_rel swapped lhs rhs mco - = rewriteEqEvidence emptyRewriterSet ev swapped lhs_redn rhs_redn - where - lhs_redn = mkGReflRightMRedn role lhs sym_mco - rhs_redn = mkGReflLeftMRedn role rhs mco - - sym_mco = mkSymMCo mco - role = eqRelRole eq_rel --} - rewriteEqEvidence :: RewriterSet -- New rewriters -- See GHC.Tc.Types.Constraint -- Note [Wanteds rewrite Wanteds] ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -40,7 +40,7 @@ module GHC.Tc.Types.Constraint ( impredicativeProblem, insolubleOccursProblem, solubleOccursProblem, occursProblem, - cterHasNoProblem, cterHasProblem, cterHasOnlyProblem, + cterHasNoProblem, cterHasProblem, cterHasOnlyProblem, cterHasOnlyProblems, cterRemoveProblem, cterHasOccursCheck, cterFromKind, CanEqLHS(..), canEqLHS_maybe, canTyFamEqLHS_maybe, @@ -551,6 +551,9 @@ CTER bits `cterHasProblem` CTEP mask = (bits .&. mask) /= 0 cterHasOnlyProblem :: CheckTyEqResult -> CheckTyEqProblem -> Bool CTER bits `cterHasOnlyProblem` CTEP mask = bits == mask +cterHasOnlyProblems :: CheckTyEqResult -> CheckTyEqResult -> Bool +CTER bits `cterHasOnlyProblems` CTER mask = (bits .&. mask) == 0 + cterRemoveProblem :: CheckTyEqResult -> CheckTyEqProblem -> CheckTyEqResult cterRemoveProblem (CTER bits) (CTEP mask) = CTER (bits .&. complement mask) ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2884,7 +2884,7 @@ But there are several cases we need to be wary of: high a level. But, when unifying, we can promote any variables we encounter. (3) We do not unify variables with a type with a free coercion hole. - See (COERCION-HOLE) in Note [Unification preconditons]. + See (COERCION-HOLE) in Note [Unification preconditions]. Note [Promotion and level-checking] @@ -3014,7 +3014,7 @@ checkTyVar (TEF { tef_lhs = lhs, tef_unifying = unifying, tef_occurs = occ_prob --------------------- check_tv NotUnifying lhs_tv -- We need an occurs-check here, but no level check - -- See Note [No level-check or promotion when not unifying] + -- See Note [Promotion and level-checking] | occursCheckTv lhs_tv occ_tv = failCheckWith (cteProblem occ_prob) | otherwise ===================================== testsuite/tests/polykinds/T18451a.hs ===================================== @@ -12,10 +12,7 @@ foo :: forall a b (c :: Const Type b). Proxy '[a, c] foo = error "ruk" -- We infer a :: k0, k0 ~ Const Type b --- And Const is forgetful, so we expand it in the RHS of unifications; --- so we end up with a :: Type. So the above is fine. --- --- This is a change (March 2023); previously we didn't expand the --- synonym, and hence failed. --- --- See Note [Forgetful synonyms in checkTyConApp] in GHC.Tc.Utils.Unify +-- We unify k0 := Const Type b (in the eager unifier) +-- And that leaves us with +-- forall (a :: Const Type b) (b :: Type) (c :: Const Type b). ...a +-- Bad! But delicate becuase we could expand the synonym ===================================== testsuite/tests/polykinds/T22793.stderr ===================================== @@ -1,36 +1,13 @@ T22793.hs:15:42: error: [GHC-25897] - • Couldn't match kind ‘ka’ with ‘k1’ - Expected kind ‘ks’, but ‘a’ has kind ‘ka’ + • Expected kind ‘ks’, but ‘a’ has kind ‘ka’ ‘ka’ is a rigid type variable bound by the type signature for ‘bob’ at T22793.hs:13:26-27 - ‘k1’ is a rigid type variable bound by - the type signature for ‘bob’ - at T22793.hs:13:16-17 - • In the second argument of ‘Foo’, namely ‘a’ - In the type signature: - bob :: forall {k1} - {ks} - {ka} - q - (p :: k1 -> q -> Type) - (f :: ka -> q) - (s :: ks) - (t :: ks) - (a :: ka) - (b :: ka). Foo s a => p a (f b) -> p s (f t) - -T22793.hs:16:11: error: [GHC-25897] - • Couldn't match kind ‘ks’ with ‘k1’ - Expected kind ‘k1’, but ‘a’ has kind ‘ka’ ‘ks’ is a rigid type variable bound by the type signature for ‘bob’ at T22793.hs:13:21-22 - ‘k1’ is a rigid type variable bound by - the type signature for ‘bob’ - at T22793.hs:13:16-17 - • In the first argument of ‘p’, namely ‘a’ + • In the second argument of ‘Foo’, namely ‘a’ In the type signature: bob :: forall {k1} {ks} ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -225,7 +225,7 @@ test('T17841', normal, compile_fail, ['']) test('T17963', normal, compile_fail, ['']) test('T18300', normal, compile_fail, ['']) test('T18451', normal, compile_fail, ['']) -test('T18451a', normal, compile, ['']) +test('T18451a', normal, compile_fail, ['']) test('NestedProxies', normal, compile, ['']) test('T18522-ppr', normal, ghci_script, ['T18522-ppr.script']) test('T18855', normal, compile, ['']) ===================================== testsuite/tests/typecheck/no_skolem_info/T14040.stderr ===================================== @@ -1,7 +1,7 @@ T14040.hs:27:46: error: [GHC-46956] - • Couldn't match kind ‘k1’ with ‘WeirdList z’ - Expected kind ‘WeirdList k1’, + • Couldn't match kind ‘k0’ with ‘WeirdList z’ + Expected kind ‘WeirdList k0’, but ‘xs’ has kind ‘WeirdList (WeirdList z)’ because kind variable ‘z’ would escape its scope This (rigid, skolem) kind variable is bound by @@ -25,8 +25,8 @@ T14040.hs:27:46: error: [GHC-46956] -> p _ wl T14040.hs:28:27: error: [GHC-46956] - • Couldn't match kind ‘k0’ with ‘z’ - Expected kind ‘WeirdList k0’, + • Couldn't match kind ‘k1’ with ‘z’ + Expected kind ‘WeirdList k1’, but ‘WeirdCons x xs’ has kind ‘WeirdList z’ because kind variable ‘z’ would escape its scope This (rigid, skolem) kind variable is bound by ===================================== testsuite/tests/typecheck/should_compile/PolytypeDecomp.stderr ===================================== @@ -8,3 +8,13 @@ PolytypeDecomp.hs:30:17: error: [GHC-91028] • In the expression: x In the first argument of ‘myLength’, namely ‘[x, f]’ In the expression: myLength [x, f] + +PolytypeDecomp.hs:30:19: error: [GHC-91028] + • Couldn't match type ‘a0’ with ‘[forall a. Maybe a]’ + Expected: Id a0 + Actual: [forall a. F [a]] + Cannot instantiate unification variable ‘a0’ + with a type involving polytypes: [forall a. Maybe a] + • In the expression: f + In the first argument of ‘myLength’, namely ‘[x, f]’ + In the expression: myLength [x, f] ===================================== testsuite/tests/typecheck/should_compile/T13651.stderr ===================================== @@ -1,6 +1,6 @@ T13651.hs:12:8: error: [GHC-25897] - • Could not deduce ‘cr ~ Bar h (Foo r)’ + • Could not deduce ‘cs ~ Bar (Foo h) (Foo s)’ from the context: (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) bound by the type signature for: @@ -8,7 +8,7 @@ T13651.hs:12:8: error: [GHC-25897] (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) => Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs) at T13651.hs:(12,8)-(14,65) - ‘cr’ is a rigid type variable bound by + ‘cs’ is a rigid type variable bound by the type signature for: foo :: forall cr cu h r u cs s. (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) => ===================================== testsuite/tests/typecheck/should_fail/tcfail097.stderr ===================================== @@ -8,9 +8,9 @@ tcfail097.hs:5:6: error: [GHC-39999] The type variable ‘a0’ is ambiguous Potentially matching instances: instance Eq Ordering -- Defined in ‘GHC.Classes’ - instance Eq Integer -- Defined in ‘GHC.Num.Integer’ - ...plus 23 others - ...plus four instances involving out-of-scope types + instance Eq () -- Defined in ‘GHC.Classes’ + ...plus 22 others + ...plus five instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the ambiguity check for ‘f’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bbba89ea59ce41364b4b3a4fba7969ca2c711d28 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bbba89ea59ce41364b4b3a4fba7969ca2c711d28 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 19 11:41:35 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 19 Mar 2023 07:41:35 -0400 Subject: [Git][ghc/ghc][wip/int-index/visibility-check] 208 commits: Fix colors in emacs terminal Message-ID: <6416f4efe9d69_20ac8436e2c10c3137d2@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/visibility-check at Glasgow Haskell Compiler / GHC Commits: 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - 027f76fa by Vladislav Zavialov at 2023-03-19T12:16:44+01:00 Ignore forall visibility in eqType (#22762) Prior to this change, the equality relation on types took ForAllTyFlag into account, making a distinction between: 1. forall a. blah 2. forall a -> blah Not anymore. This distinction is important in surface Haskell, but it has no meaning in Core where type abstraction and type application are always explicit. At the same time, if we are not careful to track this flag, Core Lint will fail, as reported in #22762: *** Core Lint errors : in result of TcGblEnv axioms *** From-kind of Cast differs from kind of enclosed type From-kind: forall (b :: Bool) -> * Kind of enclosed type: forall {b :: Bool}. * The solution is to compare types for equality modulo visibility (ForAllTyFlag). Updated functions: nonDetCmpType (worker for eqType) eqDeBruijnType tc_eq_type (worker for tcEqType) can_eq_nc In order to retain the distinction between visible and invisible forall in user-written code, we introduce new ad-hoc checks: checkEqForallVis (in checking mode) cteForallKindVisDiff (in inference mode) - - - - - 911ad91c by Vladislav Zavialov at 2023-03-19T12:28:17+01:00 Comments, refactor, tests - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - cabal.project-reinstall - compile_flags.txt - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87058d732cde1f178fd3fd5e1d8af378aef3d300...911ad91cf80d6af9fad23937eb5bf6fa35676383 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87058d732cde1f178fd3fd5e1d8af378aef3d300...911ad91cf80d6af9fad23937eb5bf6fa35676383 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 19 18:06:16 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 19 Mar 2023 14:06:16 -0400 Subject: [Git][ghc/ghc][wip/int-index/visibility-check] Fix minor oversights Message-ID: <64174f18e5f3b_18edcc33077c851617@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/visibility-check at Glasgow Haskell Compiler / GHC Commits: 90a9540f by Vladislav Zavialov at 2023-03-19T19:05:50+01:00 Fix minor oversights - - - - - 4 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - testsuite/tests/saks/should_fail/T18863a.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -373,13 +373,10 @@ tcApp rn_expr exp_res_ty -- Even though both app_res_rho and exp_res_ty are rho-types, -- they may have nested polymorphism, so if deep subsumption -- is on we must call tcSubType. - -- Zonk app_res_rho first, because QL may have instantiated some - -- delta variables to polytypes, and tcSubType doesn't expect that - do { app_res_rho <- zonkQuickLook do_ql app_res_rho - ; tcSubTypeDS rn_expr app_res_rho exp_res_ty } + tcSubTypeDS rn_expr app_res_rho exp_res_ty -- See Note [Use sites of checkEqForallVis] - -- This particualr call is commented out because we do not have + -- This particular call is commented out because we do not have -- visible forall in types of terms yet (#281), so it is a no-op. -- ; case exp_res_ty of -- Check res_ty -> checkEqForallVis app_res_rho res_ty ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2556,7 +2556,7 @@ kcCheckDeclHeader_sig sig_kind name flav AnyKind -> return () -- No signature _ -> do { res_ki <- newExpectedKind ctx_k ; discardResult (unifyKind Nothing sig_res_kind' res_ki) - ; checkEqForallVis res_ki sig_res_kind' } -- See Note [Use sites of checkEqForallVis] + ; checkEqForallVis sig_res_kind' res_ki } -- See Note [Use sites of checkEqForallVis] -- Add more binders for data/newtype, so the result kind has no arrows -- See Note [Datatype return kinds] ===================================== testsuite/tests/saks/should_fail/T18863a.stderr ===================================== @@ -1,6 +1,6 @@ T18863a.hs:9:1: error: [GHC-25115] • Visibilities of forall-bound variables are not compatible - Expected: forall i -> i -> * - Actual: forall i. i -> * + Expected: forall i. i -> * + Actual: forall i -> i -> * • In the data type declaration for ‘IDa’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -672,8 +672,6 @@ test('T22924a', normal, compile_fail, ['']) test('T22924b', normal, compile_fail, ['']) test('T22940', normal, compile_fail, ['']) test('T19627', normal, compile_fail, ['']) -test('T20666', normal, compile_fail, ['']) -test('T20666a', normal, compile_fail, ['']) test('VisFlag1', normal, compile_fail, ['']) test('VisFlag1_ql', normal, compile_fail, ['']) test('VisFlag2', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90a9540fd1bffbe905ed356adbc60ffdc6249785 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90a9540fd1bffbe905ed356adbc60ffdc6249785 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 03:18:57 2023 From: gitlab at gitlab.haskell.org (Ziyang Liu (@zliu41)) Date: Sun, 19 Mar 2023 23:18:57 -0400 Subject: [Git][ghc/ghc][wip/zliu41/spec/patch/925] Support turning off builtin rules Message-ID: <6417d0a19e1f0_18edccbaf4c587089f@gitlab.mail> Ziyang Liu pushed to branch wip/zliu41/spec/patch/925 at Glasgow Haskell Compiler / GHC Commits: 3cbf2dcd by Ziyang Liu at 2023-03-19T20:18:13-07:00 Support turning off builtin rules - - - - - 8 changed files: - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs Changes: ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -165,17 +165,18 @@ pprPassDetails _ = Outputable.empty data SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad = SimplMode - { sm_names :: [String] -- ^ Name(s) of the phase - , sm_phase :: CompilerPhase - , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options - , sm_rules :: !Bool -- ^ Whether RULES are enabled - , sm_inline :: !Bool -- ^ Whether inlining is enabled - , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled - , sm_eta_expand :: !Bool -- ^ Whether eta-expansion is enabled - , sm_cast_swizzle :: !Bool -- ^ Do we swizzle casts past lambdas? - , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled - , sm_logger :: !Logger - , sm_dflags :: DynFlags + { sm_names :: [String] -- ^ Name(s) of the phase + , sm_phase :: CompilerPhase + , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options + , sm_rules :: !Bool -- ^ Whether RULES are enabled + , sm_builtin_rules :: !Bool + , sm_inline :: !Bool -- ^ Whether inlining is enabled + , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled + , sm_eta_expand :: !Bool -- ^ Whether eta-expansion is enabled + , sm_cast_swizzle :: !Bool -- ^ Do we swizzle casts past lambdas? + , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled + , sm_logger :: !Logger + , sm_dflags :: DynFlags -- Just for convenient non-monadic access; we don't override these. -- -- Used for: ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -148,6 +148,7 @@ getCoreToDo logger dflags late_dmd_anal = gopt Opt_LateDmdAnal dflags late_specialise = gopt Opt_LateSpecialise dflags static_args = gopt Opt_StaticArgumentTransformation dflags + builtin_rules_on = gopt Opt_EnableBuiltinRules dflags rules_on = gopt Opt_EnableRewriteRules dflags eta_expand_on = gopt Opt_DoLambdaEtaExpansion dflags pre_inline_on = gopt Opt_SimplPreInlining dflags @@ -168,6 +169,7 @@ getCoreToDo logger dflags , sm_logger = logger , sm_uf_opts = unfoldingOpts dflags , sm_rules = rules_on + , sm_builtin_rules = builtin_rules_on , sm_eta_expand = eta_expand_on , sm_cast_swizzle = True , sm_inline = True ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -2248,7 +2248,7 @@ tryRules env rules fn args call_cont -} | Just (rule, rule_rhs) <- lookupRule ropts (getUnfoldingInRuleMatch env) - (activeRule (getMode env)) fn + (activeRule (getMode env)) (sm_builtin_rules (getMode env)) fn (argInfoAppArgs args) rules -- Fire a rule for the function = do { checkedTick (RuleFired (ruleName rule)) @@ -4202,4 +4202,3 @@ for the RHS as well as the LHS, but that seems more conservative than necesary. Allowing some inlining might, for example, eliminate a binding. -} - ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -868,6 +868,7 @@ simplEnvForGHCi logger dflags , sm_dflags = dflags , sm_uf_opts = uf_opts , sm_rules = rules_on + , sm_builtin_rules = builtin_rules_on , sm_inline = False -- Do not do any inlining, in case we expose some -- unboxed tuple stuff that confuses the bytecode @@ -878,10 +879,11 @@ simplEnvForGHCi logger dflags , sm_pre_inline = pre_inline_on } where - rules_on = gopt Opt_EnableRewriteRules dflags - eta_expand_on = gopt Opt_DoLambdaEtaExpansion dflags - pre_inline_on = gopt Opt_SimplPreInlining dflags - uf_opts = unfoldingOpts dflags + builtin_rules_on = gopt Opt_EnableBuiltinRules dflags + rules_on = gopt Opt_EnableRewriteRules dflags + eta_expand_on = gopt Opt_DoLambdaEtaExpansion dflags + pre_inline_on = gopt Opt_SimplPreInlining dflags + uf_opts = unfoldingOpts dflags updModeForStableUnfoldings :: Activation -> SimplMode -> SimplMode updModeForStableUnfoldings unf_act current_mode ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -1461,7 +1461,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs already_covered :: RuleOpts -> [CoreRule] -> [CoreExpr] -> Bool already_covered ropts new_rules args -- Note [Specialisations already covered] = isJust (lookupRule ropts (in_scope, realIdUnfolding) - (const True) fn args + (const True) True fn args (new_rules ++ existing_rules)) -- NB: we look both in the new_rules (generated by this invocation -- of specCalls), and in existing_rules (passed in to specCalls) ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -381,12 +381,13 @@ pprRuleBase rules = pprUFM rules $ \rss -> -- successful. lookupRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool) -- When rule is active + -> Bool -- Whether builtin rules are active -> Id -> [CoreExpr] -> [CoreRule] -> Maybe (CoreRule, CoreExpr) -- See Note [Extra args in the target] -- See comments on matchRule -lookupRule opts rule_env@(in_scope,_) is_active fn args rules +lookupRule opts rule_env@(in_scope,_) is_active builtin_is_active fn args rules = -- pprTrace "matchRules" (ppr fn <+> ppr args $$ ppr rules ) $ case go [] rules of [] -> Nothing @@ -403,7 +404,7 @@ lookupRule opts rule_env@(in_scope,_) is_active fn args rules go :: [(CoreRule,CoreExpr)] -> [CoreRule] -> [(CoreRule,CoreExpr)] go ms [] = ms go ms (r:rs) - | Just e <- matchRule opts rule_env is_active fn args' rough_args r + | Just e <- matchRule opts rule_env is_active builtin_is_active fn args' rough_args r = go ((r,mkTicks ticks e):ms) rs | otherwise = -- pprTrace "match failed" (ppr r $$ ppr args $$ @@ -490,7 +491,7 @@ start, in general eta expansion wastes work. SLPJ July 99 -} ------------------------------------ -matchRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool) +matchRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool) -> Bool -> Id -> [CoreExpr] -> [Maybe Name] -> CoreRule -> Maybe CoreExpr @@ -516,14 +517,13 @@ matchRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool) -- Any 'surplus' arguments in the input are simply put on the end -- of the output. -matchRule opts rule_env _is_active fn args _rough_args +matchRule opts rule_env _is_active builtin_is_active fn args _rough_args (BuiltinRule { ru_try = match_fn }) --- Built-in rules can't be switched off, it seems - = case match_fn opts rule_env fn args of - Nothing -> Nothing - Just expr -> Just expr + = if builtin_is_active + then match_fn opts rule_env fn args + else Nothing -matchRule _ rule_env is_active _ args rough_args +matchRule _ rule_env is_active _ _ args rough_args (Rule { ru_name = rule_name, ru_act = act, ru_rough = tpl_tops , ru_bndrs = tpl_vars, ru_args = tpl_args, ru_rhs = rhs }) | not (is_active act) = Nothing @@ -1560,7 +1560,7 @@ ruleAppCheck_help env fn args rules rule_info opts rule | Just _ <- matchRule opts (emptyInScopeSet, rc_id_unf env) - noBlackList fn args rough_args rule + noBlackList True fn args rough_args rule = text "matches (which is very peculiar!)" rule_info _ (BuiltinRule {}) = text "does not match" ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -181,6 +181,7 @@ data GeneralFlag | Opt_UnboxStrictFields | Opt_UnboxSmallStrictFields | Opt_DictsCheap + | Opt_EnableBuiltinRules | Opt_EnableRewriteRules -- Apply rewrite rules during simplification | Opt_EnableThSpliceWarnings -- Enable warnings for TH splices | Opt_RegsGraph -- do graph coloring register allocation @@ -399,6 +400,7 @@ optimisationFlags = EnumSet.fromList , Opt_UnboxStrictFields , Opt_UnboxSmallStrictFields , Opt_DictsCheap + , Opt_EnableBuiltinRules , Opt_EnableRewriteRules , Opt_RegsGraph , Opt_RegsIterative @@ -543,4 +545,3 @@ data Language = Haskell98 | Haskell2010 | GHC2021 instance Outputable Language where ppr = text . show - ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3330,6 +3330,7 @@ fFlagsDeps = [ flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion, flagSpec "eager-blackholing" Opt_EagerBlackHoling, flagSpec "embed-manifest" Opt_EmbedManifest, + flagSpec "enable-builtin-rules" Opt_EnableBuiltinRules, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings, flagSpec "error-spans" Opt_ErrorSpans, @@ -3894,7 +3895,7 @@ optLevelFlags -- see Note [Documenting optimisation flags] , ([1,2], Opt_CSE) , ([1,2], Opt_StgCSE) , ([2], Opt_StgLiftLams) - + , ([0,1,2], Opt_EnableBuiltinRules) , ([1,2], Opt_EnableRewriteRules) -- Off for -O0. Otherwise we desugar list literals -- to 'build' but don't run the simplifier passes that View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3cbf2dcdfa232c8d94303be2fc389081716393f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3cbf2dcdfa232c8d94303be2fc389081716393f9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 12:12:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 20 Mar 2023 08:12:36 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Add structured error messages for GHC.Tc.Utils.Backpack Message-ID: <64184db4a9e6c_18edcc1425c6641262e5@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - 3335095c by Andrei Borzenkov at 2023-03-20T08:12:31-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 7ec96ca0 by Simon Peyton Jones at 2023-03-20T08:12:32-04:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - 7 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/Canonical.hs - + compiler/GHC/Tc/Solver/Dict.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2bfa89e054ce4297de2fba1023545c9238a2d46f...7ec96ca06671b1a3fc3765616f4de067216f22c2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2bfa89e054ce4297de2fba1023545c9238a2d46f...7ec96ca06671b1a3fc3765616f4de067216f22c2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 14:53:03 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 20 Mar 2023 10:53:03 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] WIP: Better Hash Message-ID: <6418734f4227c_90da22109b0333c5@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: a73f90e8 by romes at 2023-03-20T14:50:21+00:00 WIP: Better Hash Co-author: @mpickering TODO: Fix identifier of rts which is depended on. What about the simple identifiers in haddocks? Perhaps we only need the full unitid for the pacckage databases. - - - - - 15 changed files: - hadrian/hadrian.cabal - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - + hadrian/src/Hadrian/Haskell/Hash.hs - + hadrian/src/Hadrian/Haskell/Hash.hs-boot - hadrian/src/Hadrian/Package.hs - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Haddock.hs Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -55,6 +55,7 @@ executable hadrian , Hadrian.BuildPath , Hadrian.Expression , Hadrian.Haskell.Cabal + , Hadrian.Haskell.Hash , Hadrian.Haskell.Cabal.Type , Hadrian.Haskell.Cabal.Parse , Hadrian.Oracles.ArgsHash @@ -163,6 +164,8 @@ executable hadrian , transformers >= 0.4 && < 0.7 , unordered-containers >= 0.2.1 && < 0.3 , text >= 1.2 && < 3 + , cryptohash-sha256 >= 0.11 && < 0.12 + , base16-bytestring >= 0.1.1 && < 1.1.0.0 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Context.hs ===================================== @@ -72,7 +72,7 @@ distDir st = do pkgFileName :: Package -> String -> String -> Action FilePath pkgFileName package prefix suffix = do - pid <- pkgIdentifier package + pid <- pkgSimpleIdentifier package return $ prefix ++ pid ++ suffix pkgFile :: Context -> String -> String -> Action FilePath @@ -97,7 +97,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") pkgHaddockFile :: Context -> Action FilePath pkgHaddockFile Context {..} = do root <- buildRoot - version <- pkgIdentifier package + version <- pkgSimpleIdentifier package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: @@ -106,7 +106,7 @@ pkgHaddockFile Context {..} = do pkgRegisteredLibraryFile :: Context -> Action FilePath pkgRegisteredLibraryFile context at Context {..} = do libDir <- libPath context - pkgId <- pkgIdentifier package + pkgId <- pkgSimpleIdentifier package fileName <- pkgRegisteredLibraryFileName context distDir <- distDir stage return $ if Dynamic `wayUnit` way @@ -136,8 +136,8 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile Context {..} = do - pid <- pkgIdentifier package +pkgConfFile context at Context {..} = do + pid <- pkgSimpleIdentifier package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -10,8 +10,8 @@ -- Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( - pkgVersion, pkgIdentifier, pkgSynopsis, pkgDescription, pkgDependencies, - pkgGenericDescription, cabalArchString, cabalOsString, + pkgVersion, pkgSimpleIdentifier, pkgUnitId, pkgSynopsis, pkgDescription, + pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString ) where import Development.Shake @@ -20,15 +20,20 @@ import Distribution.PackageDescription (GenericPackageDescription) import Hadrian.Haskell.Cabal.Type import Hadrian.Oracles.Cabal import Hadrian.Package +import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId) + -- | Read a Cabal file and return the package version. The Cabal file is tracked. pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData --- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0 at . + +-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . -- The Cabal file is tracked. -pkgIdentifier :: Package -> Action String -pkgIdentifier package = do +-- +-- For an identifier complete with the hash use 'pkgUnitId' +pkgSimpleIdentifier :: Package -> Action String +pkgSimpleIdentifier package = do cabal <- readPackageData package return $ if null (version cabal) then name cabal @@ -72,3 +77,4 @@ cabalOsString "mingw32" = "windows" cabalOsString "darwin" = "osx" cabalOsString "solaris2" = "solaris" cabalOsString other = other + ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -345,7 +345,7 @@ registerPackage rs context = do pd <- packageDescription <$> readContextData context db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context)) dist_dir <- Context.buildPath context - pid <- pkgIdentifier (package context) + pid <- pkgUnitId context -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path -- from the local build info @lbi at . lbi <- liftIO $ C.getPersistBuildConfig cPath ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -0,0 +1,229 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where + +import Development.Shake + +import Hadrian.Haskell.Cabal.Type +import Hadrian.Haskell.Cabal +import Hadrian.Oracles.Cabal +import Hadrian.Package + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as BS +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import Data.List +import Context.Type +import Oracles.Setting +import Hadrian.Target +import Hadrian.Expression +import Builder +import Flavour.Type +import Settings +import Way.Type +import Way +import Packages +import Development.Shake.Classes +import Control.Monad + + +-- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd at . +-- This needs to be an oracle so it's cached +pkgUnitId :: Context -> Action String +pkgUnitId ctx = do + pid <- pkgSimpleIdentifier (package ctx) + phash <- pkgHash ctx + -- Other boot packages still hardcode their unit-id to just , but we + -- can have hadrian generate a different unit-id for them just as cabal does + -- because the boot packages unit-ids are overriden by setting -this-unit-id + -- in the cabal file + liftIO $ print $ pid <> "-" <> truncateHash 4 phash + pure $ pid <> "-" <> truncateHash 4 phash + + where + truncateHash :: Int -> String -> String + truncateHash = take + + +data PackageHashInputs = PackageHashInputs { + pkgHashPkgId :: String, -- ^ name-version + pkgHashComponent :: PackageType, + pkgHashSourceHash :: BS.ByteString, + -- pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion), + pkgHashDirectDeps :: Set.Set String, + pkgHashOtherConfig :: PackageHashConfigInputs + } + +-- | Those parts of the package configuration that contribute to the +-- package hash computed by hadrian (which is simpler than cabal's). +-- +-- setting in Oracle.setting, which come from system.config +data PackageHashConfigInputs = PackageHashConfigInputs { + pkgHashCompilerId :: String, + pkgHashPlatform :: String, + pkgHashFlagAssignment :: [String], -- complete not partial + -- pkgHashConfigureScriptArgs :: [String], -- just ./configure for build-type Configure + pkgHashVanillaLib :: Bool, + pkgHashSharedLib :: Bool, + pkgHashDynExe :: Bool, + pkgHashFullyStaticExe :: Bool, + pkgHashGHCiLib :: Bool, + pkgHashProfLib :: Bool, + pkgHashProfExe :: Bool, +-- pkgHashProfLibDetail :: ProfDetailLevel, +-- pkgHashProfExeDetail :: ProfDetailLevel, + pkgHashCoverage :: Bool, + pkgHashOptimization :: Int, + pkgHashSplitObjs :: Bool, + pkgHashSplitSections :: Bool, + pkgHashStripLibs :: Bool, + pkgHashStripExes :: Bool, +-- pkgHashDebugInfo :: DebugInfoLevel, + pkgHashProgramArgs :: Map String [String], + pkgHashExtraLibDirs :: [FilePath], + pkgHashExtraLibDirsStatic :: [FilePath], + pkgHashExtraFrameworkDirs :: [FilePath], + pkgHashExtraIncludeDirs :: [FilePath] + -- pkgHashProgPrefix :: Maybe PathTemplate, + -- pkgHashProgSuffix :: Maybe PathTemplate, + -- pkgHashPackageDbs :: [Maybe PackageDB] + } + deriving Show + +newtype PkgHashKey = PkgHashKey Context + deriving (Binary, Eq, Hashable, NFData, Show, Typeable) +type instance RuleResult PkgHashKey = String + +pkgHash :: Context -> Action String +pkgHash = askOracle . PkgHashKey + +-- TODO: Needs to be oracle to be cached? Called lots of times +pkgHashOracle :: Rules () +pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do + ctx_data <- readContextData ctx + pkg_data <- readPackageData (package ctx) + name <- pkgSimpleIdentifier (package ctx) + let stag = stage ctx + liftIO $ print ("Package and Package Dependencies", package ctx, packageDependencies pkg_data) + stagePkgs <- stagePackages stag + depsHashes <- mapM (\pkg -> pkgHash (ctx { package = pkg })) [pkg | pkg <- packageDependencies pkg_data, pkg `elem` stagePkgs] + liftIO $ print ("Pkg Deps Hashes", depsHashes) + flav <- flavour + let flavourArgs = args flav + + targetOs <- setting TargetOs + let pkgHashCompilerId = "" + pkgHashPlatform = targetOs + libWays <- interpretInContext ctx (libraryWays flav) + dyn_ghc <- dynamicGhcPrograms flav + flags <- interpret (target ctx (Cabal Flags stag) [] []) flavourArgs + let pkgHashFlagAssignment = flags + pkgHashConfigureScriptArgs = "" + pkgHashVanillaLib = vanilla `Set.member` libWays + pkgHashSharedLib = dynamic `Set.member` libWays + pkgHashDynExe = dyn_ghc + -- TODO: fullyStatic flavour transformer + pkgHashFullyStaticExe = False + pkgHashGHCiLib = False + pkgHashProfLib = profiling `Set.member` libWays + pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag + pkgHashCoverage = False -- Can't configure this + pkgHashOptimization = 0 -- TODO: A bit tricky to configure + pkgHashSplitObjs = False -- Deprecated + pkgHashSplitSections = ghcSplitSections flav + pkgHashStripExes = False + pkgHashStripLibs = False + pkgHashDebugInfo = undefined + + ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs + let pkgHashProgramArgs = Map.singleton "ghc" ghcArgs + pkgHashExtraLibDirs = [] + pkgHashExtraLibDirsStatic = [] + pkgHashExtraFrameworkDirs = [] + pkgHashExtraIncludeDirs = [] + + let other_config = PackageHashConfigInputs{..} + + return $ BS.unpack $ Base16.encode $ SHA256.hash $ + renderPackageHashInputs $ PackageHashInputs + { + pkgHashPkgId = name + , pkgHashComponent = pkgType (package ctx) + , pkgHashSourceHash = "" + , pkgHashDirectDeps = Set.empty + , pkgHashOtherConfig = other_config + } + +prettyShow, showHashValue :: Show a => a -> String +prettyShow = show +showHashValue = show + +renderPackageHashInputs :: PackageHashInputs -> BS.ByteString +renderPackageHashInputs PackageHashInputs{ + pkgHashPkgId, + pkgHashComponent, + pkgHashSourceHash, + pkgHashDirectDeps, + -- pkgHashPkgConfigDeps, + pkgHashOtherConfig = + PackageHashConfigInputs{..} + } = + -- The purpose of this somewhat laboured rendering (e.g. why not just + -- use show?) is so that existing package hashes do not change + -- unnecessarily when new configuration inputs are added into the hash. + BS.pack $ unlines $ catMaybes $ + [ entry "pkgid" prettyShow pkgHashPkgId +-- , mentry "component" show pkgHashComponent + , entry "src" showHashValue pkgHashSourceHash + {- + , entry "pkg-config-deps" + (intercalate ", " . map (\(pn, mb_v) -> prettyShow pn ++ + case mb_v of + Nothing -> "" + Just v -> " " ++ prettyShow v) + . Set.toList) pkgHashPkgConfigDeps + -} + , entry "deps" (intercalate ", " . map prettyShow + . Set.toList) pkgHashDirectDeps + -- and then all the config + , entry "compilerid" prettyShow pkgHashCompilerId + , entry "platform" prettyShow pkgHashPlatform + , opt "flags" mempty show pkgHashFlagAssignment +-- , opt "configure-script" [] unwords pkgHashConfigureScriptArgs + , opt "vanilla-lib" True prettyShow pkgHashVanillaLib + , opt "shared-lib" False prettyShow pkgHashSharedLib + , opt "dynamic-exe" False prettyShow pkgHashDynExe + , opt "fully-static-exe" False prettyShow pkgHashFullyStaticExe + , opt "ghci-lib" False prettyShow pkgHashGHCiLib + , opt "prof-lib" False prettyShow pkgHashProfLib + , opt "prof-exe" False prettyShow pkgHashProfExe + -- , opt "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail + -- , opt "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail + , opt "hpc" False prettyShow pkgHashCoverage + , opt "optimisation" 0 (show) pkgHashOptimization + , opt "split-objs" False prettyShow pkgHashSplitObjs + , opt "split-sections" False prettyShow pkgHashSplitSections + , opt "stripped-lib" False prettyShow pkgHashStripLibs + , opt "stripped-exe" True prettyShow pkgHashStripExes +-- , opt "debug-info" NormalDebugInfo (show . fromEnum) pkgHashDebugInfo + , opt "extra-lib-dirs" [] unwords pkgHashExtraLibDirs + , opt "extra-lib-dirs-static" [] unwords pkgHashExtraLibDirsStatic + , opt "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs + , opt "extra-include-dirs" [] unwords pkgHashExtraIncludeDirs +-- , opt "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix +-- , opt "prog-suffix" Nothing (maybe "" fromPathTemplate) pkgHashProgSuffix +-- , opt "package-dbs" [] (unwords . map show) pkgHashPackageDbs + + ] ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs + where + entry key format value = Just (key ++ ": " ++ format value) + mentry key format value = fmap (\v -> key ++ ": " ++ format v) value + opt key def format value + | value == def = Nothing + | otherwise = entry key format value ===================================== hadrian/src/Hadrian/Haskell/Hash.hs-boot ===================================== @@ -0,0 +1,7 @@ +module Hadrian.Haskell.Hash where + +import Context.Type +import Development.Shake + +pkgUnitId :: Context -> Action String + ===================================== hadrian/src/Hadrian/Package.hs ===================================== @@ -81,4 +81,4 @@ instance NFData PackageType instance Binary Package instance Hashable Package -instance NFData Package \ No newline at end of file +instance NFData Package ===================================== hadrian/src/Rules.hs ===================================== @@ -8,6 +8,7 @@ import qualified Hadrian.Oracles.Cabal.Rules import qualified Hadrian.Oracles.DirectoryContents import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile +import qualified Hadrian.Haskell.Hash import Expression import qualified Oracles.Flavour @@ -142,6 +143,7 @@ oracleRules :: Rules () oracleRules = do Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs Hadrian.Oracles.Cabal.Rules.cabalOracle + Hadrian.Haskell.Hash.pkgHashOracle Hadrian.Oracles.DirectoryContents.directoryContentsOracle Hadrian.Oracles.Path.pathOracle Hadrian.Oracles.TextFile.textFileOracle ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,7 +132,7 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgSimpleIdentifier rts let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -10,7 +10,7 @@ import Utilities import qualified System.Directory.Extra as IO import Data.Either import Rules.BinaryDist -import Hadrian.Haskell.Cabal (pkgIdentifier) +import Hadrian.Haskell.Cabal (pkgSimpleIdentifier) import Oracles.Setting {- @@ -54,7 +54,7 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgSimpleIdentifier rts let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -14,6 +14,8 @@ import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting import Hadrian.Haskell.Cabal.Type (PackageData(version)) +import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Hash import Hadrian.Oracles.Cabal (readPackageData) import Packages import Rules.Libffi @@ -486,16 +488,14 @@ generateConfigHs = do trackGenerateHs cProjectName <- getSetting ProjectName cBooterVersion <- getSetting GhcVersion - cProjectVersionMunged <- getSetting ProjectVersionMunged - -- ROMES:TODO:HASH First we attempt a fixed unit-id with version but without hash. - -- - -- We now use a more informative unit-id for ghc. See Note [GHC's Unit Id] - -- in GHC.Unit.Types + -- We now give a unit-id with a version and a hash to ghc. + -- See Note [GHC's Unit Id] in GHC.Unit.Types -- -- It's crucial that the unit-id matches the unit-key -- ghc is no longer -- part of the WiringMap, so we don't to go back and forth between the - -- unit-id and the unit-key -- we take care here that they are the same. - let cProjectUnitId = "ghc-" ++ cProjectVersionMunged -- ROMES:TODO:HASH + -- unit-id and the unit-key -- we take care that they are the same by using + -- 'pkgUnitId' to create the unit-id in both situations. + cProjectUnitId <- expr . pkgUnitId =<< getContext return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -592,3 +592,5 @@ generatePlatformHostHs = do , "hostPlatformArchOS :: ArchOS" , "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS" ] + + ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -183,7 +183,7 @@ buildConfFinal rs context at Context {..} _conf = do -- so that if any change ends up modifying a library (but not its .conf -- file), we still rebuild things that depend on it. dir <- (-/-) <$> libPath context <*> distDir stage - pkgid <- pkgIdentifier package + pkgid <- pkgUnitId context files <- liftIO $ (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -84,8 +84,9 @@ cabalSetupArgs = builder (Cabal Setup) ? do commonCabalArgs :: Stage -> Args commonCabalArgs stage = do verbosity <- expr getVerbosity + ctx <- getContext pkg <- getPackage - package_id <- expr $ pkgIdentifier pkg + package_id <- expr $ pkgSimpleIdentifier pkg let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..") mconcat [ -- Don't strip libraries when cross compiling. -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -3,6 +3,7 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Hash import Hadrian.Haskell.Cabal.Type import Flavour @@ -14,6 +15,7 @@ import Rules.Libffi (libffiName) import qualified Data.Set as Set import System.Directory import Data.Version.Extra +import Hadrian.Haskell.Hash ghcBuilderArgs :: Args ghcBuilderArgs = mconcat @@ -243,21 +245,24 @@ wayGhcArgs = do , (way == debug || way == debugDynamic) ? pure ["-ticky", "-DTICKY_TICKY"] ] +-- | Args related to correct handling of packages, such as setting +-- -this-unit-id and passing -package-id for dependencies packageGhcArgs :: Args packageGhcArgs = do package <- getPackage + ctx <- getContext ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) -- ROMES: Until the boot compiler no longer needs ghc's -- unit-id to be "ghc", the stage0 compiler must be built -- with `-this-unit-id ghc`, while the wired-in unit-id of -- ghc is correctly set to the unit-id we'll generate for - -- stage1 (set in generateVersionHs in Rules.Generate). + -- stage1 (set in generateConfigHs in Rules.Generate). -- -- However, we don't need to set the unit-id of "ghc" to "ghc" when -- building stage0 because we have a flag in compiler/ghc.cabal.in that is -- sets `-this-unit-id ghc` when hadrian is building stage0, which will -- overwrite this one. - pkgId <- expr $ pkgIdentifier package + pkgId <- expr $ pkgUnitId ctx mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -42,7 +42,7 @@ haddockBuilderArgs = mconcat version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg haddocks <- expr $ haddockDependencies context - haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks] + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgSimpleIdentifier p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a73f90e80faa7bf7f770a7edd52320ecff60f683 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a73f90e80faa7bf7f770a7edd52320ecff60f683 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 15:10:48 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 20 Mar 2023 11:10:48 -0400 Subject: [Git][ghc/ghc][wip/js-exports] JS/FFI/Callbacks: add user guide documentation Message-ID: <6418777894091_90da2ebe72038449@gitlab.mail> Josh Meredith pushed to branch wip/js-exports at Glasgow Haskell Compiler / GHC Commits: ef9a48e5 by Josh Meredith at 2023-03-20T15:10:32+00:00 JS/FFI/Callbacks: add user guide documentation - - - - - 1 changed file: - docs/users_guide/exts/ffi.rst Changes: ===================================== docs/users_guide/exts/ffi.rst ===================================== @@ -1137,3 +1137,173 @@ byte array can be pinned as a result of three possible causes: ``GHC.Exts.readWord8Array#`` for this. .. [3] As in [2]_, the FFI is not actually needed for this. ``GHC.Exts`` includes primitives for reading from on ``ArrayArray#``. + +.. _ffi-javascript + +FFI and the JavaScript Backend +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. index:: + single: FFI and the JavaScript Backend + +GHC's JavaScript backend supports its own calling convention for +JavaScript-specific foreign imports. Instead of a function name, +the import string expected to be an unapplied JavaScript `arrow +function `_. + +Arrow functions enable the use of arbitrary JavaScript in import +strings, so a simple example might look like: + +.. code-block:: haskell + + foreign import javascript "((x,y) => { return x + y; })" + js_add :: Int -> Int -> Int + +JSVal +^^^^^ + +The JavaScript backend has a concept of an untyped 'plain' JavaScript +value, under the guise of the type ``JSVal``. While many Haskell data +types are represented in JavaScript-incompatible ways under-the-hood, +``JSVal`` is represented as a real JavaScript object. + +The module ``GHC.JS.Prim`` from ``base`` contains functions for working +with foreign ``JSVal`` objects. Currently, it can contains the following +conversions: + +* ``Int`` <-> ``JSVal`` (``toJSInt``, ``fromJSInt``) +* ``String`` <-> ``JSVal`` (``toJSString``, ``fromJSString``) +* ``[JSVal]`` <-> ``JSVal`` (``toJSArray``, ``fromJSArray``) + +It also contains functions for working with objects: + +* ``jsNull :: JSVal`` - the JavaScript ``null`` +* ``isNull :: JSVal -> Bool`` - test for the JavaScript ``null`` +* ``isUndefined :: JSVal -> Bool`` - test for the JavaScript ``undefined`` +* ``getProp :: JSVal -> String -> JSVal`` - object field access + +JavaScript FFI Types +^^^^^^^^^^^^^^^^^^^^ + +Some types are able to be used directly in the type signatures of foreign +exports, without conversion to a ``JSVal``. We saw in the first example +that ``Int`` is one of these. + +The supported types are those with primitive JavaScript representations +that match the Haskell type. This means types such as the Haskell ``String`` +type aren't supported directly, because they're lists - which don't have +a primitive JavaScript representation, and so are incompatible with each +other. + +The following types are supported in this way: + +* ``Int`` +* ``Bool`` +* ``Char`` + +As in the C FFI, types in the JavaScript FFI can't be type checked, so +the following example would compile successfully - despite the type +error: + +.. code-block:: haskell + + foreign import javascript "((x) => { return 5; })" + type_error :: Bool -> Bool + +JavaScript Callbacks +^^^^^^^^^^^^^^^^^^^^ + +The JavaScript execution model is based around callback functions, and +GHC's JavaScript backend implements these as a type in order to support +useful browser programs, and programs interacting with JavaScript libraries. + +The module ``GHC.JS.Foreign.Callback`` in ``base`` defines the type ``Callback a``, +as well as several functions to construct callbacks from Haskell functions +of up to three ``JSVal`` arguments. Unlike a regular function, a ``Callback`` +function is passed in the FFI as a plain JavaScript function - enabling us to call +these functions from within JavaScript: + +.. code-block:: haskell + + foreign import javascript "((f) => { f('Example!'); })" + callback_example :: Callback (JSVal -> IO ()) -> IO () + + printJSValAsString :: JSVal -> IO () + printJSValAsString = putStrLn . fromJSString + + main :: IO () + main = do + printJS <- syncCallback1 ThrowWouldBlock printJSValAsString + callback_example printJS + releaseCallback printJS + +This example will call our ``printJSValAsString`` function, via JavaScript, +with the JavaScript string ``Example!`` as an argument. On the last line, +the callback memory is freed. Since there's no way for the Haskell JS runtime +to know if a function is still being referenced by JavaScript code, the memory +must be manually released when no longer needed. + +On the first line of ``main``, we see where the ``Callback`` is actually +created, by ``syncCallback1``. ``syncCallback`` has versions up to three, +including a zero-argument version with no suffix. + +There are three categories of functions that create callbacks, with the +arity-1 type signatures shown here for demonstration: + +* ``syncCallback1 :: (JSVal -> IO ()) -> OnBlocked -> IO (Callback (JSVal -> IO ()))``: + Synchronous callbacks that don't return a value. These take an additional + ``data OnBlocked = ThrowWouldBlock | ContinueAsync`` argument for use in the + case that the thread becomes blocked on e.g. an ``MVar`` transaction. + +* ``syncCallback' :: (JSVal -> IO JSVal) -> IO (Callback (JSVal -> IO ()))``: + Synchronous callbacks that return a value. Because of the return value, there + is no possibility of continuing asynchronously, so no ``OnBlocked`` argument + is taken. + +* ``asyncCallback :: (JSVal -> IO ()) -> IO (Callback (JSVal -> IO ()))``: + Asynchronous callbacks that immediately start in a new thread. Cannot return a + value. + +There is no checking that the passed arguments match the callback, so the +following example compiles and correctly prints 10, despite the argument being +passed as an ``Int`` to a ``Callback`` that accepts a ``JSVal``: + +.. code-block:: haskell + + foreign import javascript "((f,x) => { return f(x); })" + apply_int :: Callback (JSVal -> IO JSVal) -> Int -> IO Int + + main :: IO () + main = do + add3 <- syncCallback1' (return . (+3)) + print =<< apply_int add3 7 + releaseCallback add3 + +Callbacks as Foreign Exports +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +JavaScript callbacks allow for a sort of FFI exports via FFI imports. To do +this, a global JavaScript variable is set, and that global variable can then +be called from use cases that access plain JavaScript functions - such as +interactive HTML elements. This would look like: + +.. code-block:: haskell + + foreign import javascript "((f) => { globalF = f })" + setF :: Callback (JSVal -> IO ()) -> IO () + + main :: IO () + main = do + log <- syncCallback1 ThrowWouldBlock (print . fromJSString) + setF log + -- don't releaseCallback log + + +.. code-block:: html + + + +We have to make sure not to use ``releaseCallback`` on any functions that +are to be available in HTML, because we want these functions to be in +memory indefinitely. + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef9a48e565d126b514aeb710dcb816cce4734097 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef9a48e565d126b514aeb710dcb816cce4734097 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 15:13:34 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 20 Mar 2023 11:13:34 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] 2 commits: WIP: Better Hash Message-ID: <6418781e28bf2_90da2fca0c4390b8@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: c0334fd0 by romes at 2023-03-20T14:57:14+00:00 WIP: Better Hash Co-author: @mpickering TODO: Fix identifier of rts which is depended on. What about the simple identifiers in haddocks? Perhaps we only need the full unitid for the pacckage databases. - - - - - c5ec7ed7 by romes at 2023-03-20T15:13:17+00:00 WIP Infinite Loopy Hadrian - - - - - 15 changed files: - hadrian/hadrian.cabal - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - + hadrian/src/Hadrian/Haskell/Hash.hs - + hadrian/src/Hadrian/Haskell/Hash.hs-boot - hadrian/src/Hadrian/Package.hs - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Haddock.hs Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -55,6 +55,7 @@ executable hadrian , Hadrian.BuildPath , Hadrian.Expression , Hadrian.Haskell.Cabal + , Hadrian.Haskell.Hash , Hadrian.Haskell.Cabal.Type , Hadrian.Haskell.Cabal.Parse , Hadrian.Oracles.ArgsHash @@ -163,6 +164,8 @@ executable hadrian , transformers >= 0.4 && < 0.7 , unordered-containers >= 0.2.1 && < 0.3 , text >= 1.2 && < 3 + , cryptohash-sha256 >= 0.11 && < 0.12 + , base16-bytestring >= 0.1.1 && < 1.1.0.0 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Context.hs ===================================== @@ -70,15 +70,15 @@ distDir st = do hostArch <- cabalArchString <$> setting arch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version -pkgFileName :: Package -> String -> String -> Action FilePath -pkgFileName package prefix suffix = do - pid <- pkgIdentifier package +pkgFileName :: Context -> Package -> String -> String -> Action FilePath +pkgFileName context package prefix suffix = do + pid <- pkgUnitId context package return $ prefix ++ pid ++ suffix pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - fileName <- pkgFileName package prefix suffix + fileName <- pkgFileName context package prefix suffix return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. @@ -95,9 +95,9 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile Context {..} = do +pkgHaddockFile context at Context {..} = do root <- buildRoot - version <- pkgIdentifier package + version <- pkgUnitId context package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: @@ -106,7 +106,7 @@ pkgHaddockFile Context {..} = do pkgRegisteredLibraryFile :: Context -> Action FilePath pkgRegisteredLibraryFile context at Context {..} = do libDir <- libPath context - pkgId <- pkgIdentifier package + pkgId <- pkgUnitId context package fileName <- pkgRegisteredLibraryFileName context distDir <- distDir stage return $ if Dynamic `wayUnit` way @@ -115,9 +115,9 @@ pkgRegisteredLibraryFile context at Context {..} = do -- | Just the final filename portion of pkgRegisteredLibraryFile pkgRegisteredLibraryFileName :: Context -> Action FilePath -pkgRegisteredLibraryFileName Context{..} = do +pkgRegisteredLibraryFileName context at Context{..} = do extension <- libsuf stage way - pkgFileName package "libHS" extension + pkgFileName context package "libHS" extension -- | Path to the library file of a given 'Context', e.g.: @@ -136,8 +136,8 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile Context {..} = do - pid <- pkgIdentifier package +pkgConfFile context at Context {..} = do + pid <- pkgUnitId context package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -10,8 +10,8 @@ -- Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( - pkgVersion, pkgIdentifier, pkgSynopsis, pkgDescription, pkgDependencies, - pkgGenericDescription, cabalArchString, cabalOsString, + pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, + pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString ) where import Development.Shake @@ -20,20 +20,13 @@ import Distribution.PackageDescription (GenericPackageDescription) import Hadrian.Haskell.Cabal.Type import Hadrian.Oracles.Cabal import Hadrian.Package +import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId) + -- | Read a Cabal file and return the package version. The Cabal file is tracked. pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData --- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0 at . --- The Cabal file is tracked. -pkgIdentifier :: Package -> Action String -pkgIdentifier package = do - cabal <- readPackageData package - return $ if null (version cabal) - then name cabal - else name cabal ++ "-" ++ version cabal - -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. pkgSynopsis :: Package -> Action String pkgSynopsis = fmap synopsis . readPackageData @@ -72,3 +65,4 @@ cabalOsString "mingw32" = "windows" cabalOsString "darwin" = "osx" cabalOsString "solaris2" = "solaris" cabalOsString other = other + ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -345,7 +345,7 @@ registerPackage rs context = do pd <- packageDescription <$> readContextData context db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context)) dist_dir <- Context.buildPath context - pid <- pkgIdentifier (package context) + pid <- pkgUnitId context (package context) -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path -- from the local build info @lbi at . lbi <- liftIO $ C.getPersistBuildConfig cPath ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -0,0 +1,240 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where + +import Development.Shake + +import Hadrian.Haskell.Cabal.Type as C +import Hadrian.Haskell.Cabal +import Hadrian.Oracles.Cabal +import Hadrian.Package + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as BS +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import Data.List +import Context.Type +import Oracles.Setting +import Hadrian.Target +import Hadrian.Expression +import Builder +import Flavour.Type +import Settings +import Way.Type +import Way +import Packages +import Development.Shake.Classes +import Control.Monad + + +-- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd at . +-- This needs to be an oracle so it's cached +pkgUnitId :: Context -> Package -> Action String +pkgUnitId ctx' pkg = do + let ctx = ctx{package = pkg} + pid <- pkgSimpleIdentifier (package ctx) + phash <- pkgHash ctx + -- Other boot packages still hardcode their unit-id to just , but we + -- can have hadrian generate a different unit-id for them just as cabal does + -- because the boot packages unit-ids are overriden by setting -this-unit-id + -- in the cabal file + liftIO $ print $ pid <> "-" <> truncateHash 4 phash + pure $ pid <> "-" <> truncateHash 4 phash + + where + truncateHash :: Int -> String -> String + truncateHash = take + +-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . +-- The Cabal file is tracked. +-- +-- For an identifier complete with the hash use 'pkgUnitId' +pkgSimpleIdentifier :: Package -> Action String +pkgSimpleIdentifier package = do + cabal <- readPackageData package + return $ if null (version cabal) + then C.name cabal + else C.name cabal ++ "-" ++ version cabal + +data PackageHashInputs = PackageHashInputs { + pkgHashPkgId :: String, -- ^ name-version + pkgHashComponent :: PackageType, + pkgHashSourceHash :: BS.ByteString, + -- pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion), + pkgHashDirectDeps :: Set.Set String, + pkgHashOtherConfig :: PackageHashConfigInputs + } + +-- | Those parts of the package configuration that contribute to the +-- package hash computed by hadrian (which is simpler than cabal's). +-- +-- setting in Oracle.setting, which come from system.config +data PackageHashConfigInputs = PackageHashConfigInputs { + pkgHashCompilerId :: String, + pkgHashPlatform :: String, + pkgHashFlagAssignment :: [String], -- complete not partial + -- pkgHashConfigureScriptArgs :: [String], -- just ./configure for build-type Configure + pkgHashVanillaLib :: Bool, + pkgHashSharedLib :: Bool, + pkgHashDynExe :: Bool, + pkgHashFullyStaticExe :: Bool, + pkgHashGHCiLib :: Bool, + pkgHashProfLib :: Bool, + pkgHashProfExe :: Bool, +-- pkgHashProfLibDetail :: ProfDetailLevel, +-- pkgHashProfExeDetail :: ProfDetailLevel, + pkgHashCoverage :: Bool, + pkgHashOptimization :: Int, + pkgHashSplitObjs :: Bool, + pkgHashSplitSections :: Bool, + pkgHashStripLibs :: Bool, + pkgHashStripExes :: Bool, +-- pkgHashDebugInfo :: DebugInfoLevel, + pkgHashProgramArgs :: Map String [String], + pkgHashExtraLibDirs :: [FilePath], + pkgHashExtraLibDirsStatic :: [FilePath], + pkgHashExtraFrameworkDirs :: [FilePath], + pkgHashExtraIncludeDirs :: [FilePath] + -- pkgHashProgPrefix :: Maybe PathTemplate, + -- pkgHashProgSuffix :: Maybe PathTemplate, + -- pkgHashPackageDbs :: [Maybe PackageDB] + } + deriving Show + +newtype PkgHashKey = PkgHashKey Context + deriving (Binary, Eq, Hashable, NFData, Show, Typeable) +type instance RuleResult PkgHashKey = String + +pkgHash :: Context -> Action String +pkgHash = askOracle . PkgHashKey + +-- TODO: Needs to be oracle to be cached? Called lots of times +pkgHashOracle :: Rules () +pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do + ctx_data <- readContextData ctx + pkg_data <- readPackageData (package ctx) + name <- pkgSimpleIdentifier (package ctx) + let stag = stage ctx + liftIO $ print ("Package and Package Dependencies", package ctx, packageDependencies pkg_data) + stagePkgs <- stagePackages stag + depsHashes <- mapM (\pkg -> pkgHash (ctx { package = pkg })) [pkg | pkg <- packageDependencies pkg_data, pkg `elem` stagePkgs] + liftIO $ print ("Pkg Deps Hashes", depsHashes) + flav <- flavour + let flavourArgs = args flav + + targetOs <- setting TargetOs + let pkgHashCompilerId = "" + pkgHashPlatform = targetOs + libWays <- interpretInContext ctx (libraryWays flav) + dyn_ghc <- dynamicGhcPrograms flav + flags <- interpret (target ctx (Cabal Flags stag) [] []) flavourArgs + let pkgHashFlagAssignment = flags + pkgHashConfigureScriptArgs = "" + pkgHashVanillaLib = vanilla `Set.member` libWays + pkgHashSharedLib = dynamic `Set.member` libWays + pkgHashDynExe = dyn_ghc + -- TODO: fullyStatic flavour transformer + pkgHashFullyStaticExe = False + pkgHashGHCiLib = False + pkgHashProfLib = profiling `Set.member` libWays + pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag + pkgHashCoverage = False -- Can't configure this + pkgHashOptimization = 0 -- TODO: A bit tricky to configure + pkgHashSplitObjs = False -- Deprecated + pkgHashSplitSections = ghcSplitSections flav + pkgHashStripExes = False + pkgHashStripLibs = False + pkgHashDebugInfo = undefined + + ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs + let pkgHashProgramArgs = Map.singleton "ghc" ghcArgs + pkgHashExtraLibDirs = [] + pkgHashExtraLibDirsStatic = [] + pkgHashExtraFrameworkDirs = [] + pkgHashExtraIncludeDirs = [] + + let other_config = PackageHashConfigInputs{..} + + return $ BS.unpack $ Base16.encode $ SHA256.hash $ + renderPackageHashInputs $ PackageHashInputs + { + pkgHashPkgId = name + , pkgHashComponent = pkgType (package ctx) + , pkgHashSourceHash = "" + , pkgHashDirectDeps = Set.empty + , pkgHashOtherConfig = other_config + } + +prettyShow, showHashValue :: Show a => a -> String +prettyShow = show +showHashValue = show + +renderPackageHashInputs :: PackageHashInputs -> BS.ByteString +renderPackageHashInputs PackageHashInputs{ + pkgHashPkgId, + pkgHashComponent, + pkgHashSourceHash, + pkgHashDirectDeps, + -- pkgHashPkgConfigDeps, + pkgHashOtherConfig = + PackageHashConfigInputs{..} + } = + -- The purpose of this somewhat laboured rendering (e.g. why not just + -- use show?) is so that existing package hashes do not change + -- unnecessarily when new configuration inputs are added into the hash. + BS.pack $ unlines $ catMaybes $ + [ entry "pkgid" prettyShow pkgHashPkgId +-- , mentry "component" show pkgHashComponent + , entry "src" showHashValue pkgHashSourceHash + {- + , entry "pkg-config-deps" + (intercalate ", " . map (\(pn, mb_v) -> prettyShow pn ++ + case mb_v of + Nothing -> "" + Just v -> " " ++ prettyShow v) + . Set.toList) pkgHashPkgConfigDeps + -} + , entry "deps" (intercalate ", " . map prettyShow + . Set.toList) pkgHashDirectDeps + -- and then all the config + , entry "compilerid" prettyShow pkgHashCompilerId + , entry "platform" prettyShow pkgHashPlatform + , opt "flags" mempty show pkgHashFlagAssignment +-- , opt "configure-script" [] unwords pkgHashConfigureScriptArgs + , opt "vanilla-lib" True prettyShow pkgHashVanillaLib + , opt "shared-lib" False prettyShow pkgHashSharedLib + , opt "dynamic-exe" False prettyShow pkgHashDynExe + , opt "fully-static-exe" False prettyShow pkgHashFullyStaticExe + , opt "ghci-lib" False prettyShow pkgHashGHCiLib + , opt "prof-lib" False prettyShow pkgHashProfLib + , opt "prof-exe" False prettyShow pkgHashProfExe + -- , opt "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail + -- , opt "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail + , opt "hpc" False prettyShow pkgHashCoverage + , opt "optimisation" 0 (show) pkgHashOptimization + , opt "split-objs" False prettyShow pkgHashSplitObjs + , opt "split-sections" False prettyShow pkgHashSplitSections + , opt "stripped-lib" False prettyShow pkgHashStripLibs + , opt "stripped-exe" True prettyShow pkgHashStripExes +-- , opt "debug-info" NormalDebugInfo (show . fromEnum) pkgHashDebugInfo + , opt "extra-lib-dirs" [] unwords pkgHashExtraLibDirs + , opt "extra-lib-dirs-static" [] unwords pkgHashExtraLibDirsStatic + , opt "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs + , opt "extra-include-dirs" [] unwords pkgHashExtraIncludeDirs +-- , opt "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix +-- , opt "prog-suffix" Nothing (maybe "" fromPathTemplate) pkgHashProgSuffix +-- , opt "package-dbs" [] (unwords . map show) pkgHashPackageDbs + + ] ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs + where + entry key format value = Just (key ++ ": " ++ format value) + mentry key format value = fmap (\v -> key ++ ": " ++ format v) value + opt key def format value + | value == def = Nothing + | otherwise = entry key format value ===================================== hadrian/src/Hadrian/Haskell/Hash.hs-boot ===================================== @@ -0,0 +1,8 @@ +module Hadrian.Haskell.Hash where + +import Context.Type +import Hadrian.Package +import Development.Shake + +pkgUnitId :: Context -> Package -> Action String + ===================================== hadrian/src/Hadrian/Package.hs ===================================== @@ -81,4 +81,4 @@ instance NFData PackageType instance Binary Package instance Hashable Package -instance NFData Package \ No newline at end of file +instance NFData Package ===================================== hadrian/src/Rules.hs ===================================== @@ -8,6 +8,7 @@ import qualified Hadrian.Oracles.Cabal.Rules import qualified Hadrian.Oracles.DirectoryContents import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile +import qualified Hadrian.Haskell.Hash import Expression import qualified Oracles.Flavour @@ -142,6 +143,7 @@ oracleRules :: Rules () oracleRules = do Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs Hadrian.Oracles.Cabal.Rules.cabalOracle + Hadrian.Haskell.Hash.pkgHashOracle Hadrian.Oracles.DirectoryContents.directoryContentsOracle Hadrian.Oracles.Path.pathOracle Hadrian.Oracles.TextFile.textFileOracle ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,7 +132,7 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -10,7 +10,7 @@ import Utilities import qualified System.Directory.Extra as IO import Data.Either import Rules.BinaryDist -import Hadrian.Haskell.Cabal (pkgIdentifier) +import Hadrian.Haskell.Cabal (pkgUnitId) import Oracles.Setting {- @@ -54,7 +54,7 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -14,6 +14,7 @@ import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting import Hadrian.Haskell.Cabal.Type (PackageData(version)) +import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal (readPackageData) import Packages import Rules.Libffi @@ -486,16 +487,14 @@ generateConfigHs = do trackGenerateHs cProjectName <- getSetting ProjectName cBooterVersion <- getSetting GhcVersion - cProjectVersionMunged <- getSetting ProjectVersionMunged - -- ROMES:TODO:HASH First we attempt a fixed unit-id with version but without hash. - -- - -- We now use a more informative unit-id for ghc. See Note [GHC's Unit Id] - -- in GHC.Unit.Types + -- We now give a unit-id with a version and a hash to ghc. + -- See Note [GHC's Unit Id] in GHC.Unit.Types -- -- It's crucial that the unit-id matches the unit-key -- ghc is no longer -- part of the WiringMap, so we don't to go back and forth between the - -- unit-id and the unit-key -- we take care here that they are the same. - let cProjectUnitId = "ghc-" ++ cProjectVersionMunged -- ROMES:TODO:HASH + -- unit-id and the unit-key -- we take care that they are the same by using + -- 'pkgUnitId' to create the unit-id in both situations. + cProjectUnitId <- expr . (`pkgUnitId` ghc) =<< getContext return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -592,3 +591,5 @@ generatePlatformHostHs = do , "hostPlatformArchOS :: ArchOS" , "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS" ] + + ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -183,7 +183,7 @@ buildConfFinal rs context at Context {..} _conf = do -- so that if any change ends up modifying a library (but not its .conf -- file), we still rebuild things that depend on it. dir <- (-/-) <$> libPath context <*> distDir stage - pkgid <- pkgIdentifier package + pkgid <- pkgUnitId context package files <- liftIO $ (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -84,8 +84,9 @@ cabalSetupArgs = builder (Cabal Setup) ? do commonCabalArgs :: Stage -> Args commonCabalArgs stage = do verbosity <- expr getVerbosity + ctx <- getContext pkg <- getPackage - package_id <- expr $ pkgIdentifier pkg + package_id <- expr $ pkgUnitId ctx pkg let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..") mconcat [ -- Don't strip libraries when cross compiling. -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -243,21 +243,24 @@ wayGhcArgs = do , (way == debug || way == debugDynamic) ? pure ["-ticky", "-DTICKY_TICKY"] ] +-- | Args related to correct handling of packages, such as setting +-- -this-unit-id and passing -package-id for dependencies packageGhcArgs :: Args packageGhcArgs = do package <- getPackage + ctx <- getContext ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) -- ROMES: Until the boot compiler no longer needs ghc's -- unit-id to be "ghc", the stage0 compiler must be built -- with `-this-unit-id ghc`, while the wired-in unit-id of -- ghc is correctly set to the unit-id we'll generate for - -- stage1 (set in generateVersionHs in Rules.Generate). + -- stage1 (set in generateConfigHs in Rules.Generate). -- -- However, we don't need to set the unit-id of "ghc" to "ghc" when -- building stage0 because we have a flag in compiler/ghc.cabal.in that is -- sets `-this-unit-id ghc` when hadrian is building stage0, which will -- overwrite this one. - pkgId <- expr $ pkgIdentifier package + pkgId <- expr $ pkgUnitId ctx package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -42,7 +42,7 @@ haddockBuilderArgs = mconcat version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg haddocks <- expr $ haddockDependencies context - haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks] + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgUnitId context p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a73f90e80faa7bf7f770a7edd52320ecff60f683...c5ec7ed7f102ac70df487306a141b59914032ef8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a73f90e80faa7bf7f770a7edd52320ecff60f683...c5ec7ed7f102ac70df487306a141b59914032ef8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 15:19:11 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 20 Mar 2023 11:19:11 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] WIP Recursive oracles Message-ID: <6418796f1e1d4_90da2cf2acc398d6@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 93a0c648 by romes at 2023-03-20T15:18:54+00:00 WIP Recursive oracles - - - - - 12 changed files: - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Haskell/Hash.hs-boot - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Haddock.hs Changes: ===================================== hadrian/src/Context.hs ===================================== @@ -70,15 +70,15 @@ distDir st = do hostArch <- cabalArchString <$> setting arch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version -pkgFileName :: Package -> String -> String -> Action FilePath -pkgFileName package prefix suffix = do - pid <- pkgSimpleIdentifier package +pkgFileName :: Context -> Package -> String -> String -> Action FilePath +pkgFileName context package prefix suffix = do + pid <- pkgUnitId context package return $ prefix ++ pid ++ suffix pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - fileName <- pkgFileName package prefix suffix + fileName <- pkgFileName context package prefix suffix return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. @@ -95,9 +95,9 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile Context {..} = do +pkgHaddockFile context at Context {..} = do root <- buildRoot - version <- pkgSimpleIdentifier package + version <- pkgUnitId context package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: @@ -106,7 +106,7 @@ pkgHaddockFile Context {..} = do pkgRegisteredLibraryFile :: Context -> Action FilePath pkgRegisteredLibraryFile context at Context {..} = do libDir <- libPath context - pkgId <- pkgSimpleIdentifier package + pkgId <- pkgUnitId context package fileName <- pkgRegisteredLibraryFileName context distDir <- distDir stage return $ if Dynamic `wayUnit` way @@ -115,9 +115,9 @@ pkgRegisteredLibraryFile context at Context {..} = do -- | Just the final filename portion of pkgRegisteredLibraryFile pkgRegisteredLibraryFileName :: Context -> Action FilePath -pkgRegisteredLibraryFileName Context{..} = do +pkgRegisteredLibraryFileName context at Context{..} = do extension <- libsuf stage way - pkgFileName package "libHS" extension + pkgFileName context package "libHS" extension -- | Path to the library file of a given 'Context', e.g.: @@ -137,7 +137,7 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath pkgConfFile context at Context {..} = do - pid <- pkgSimpleIdentifier package + pid <- pkgUnitId context package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -10,7 +10,7 @@ -- Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( - pkgVersion, pkgSimpleIdentifier, pkgUnitId, pkgSynopsis, pkgDescription, + pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString ) where @@ -27,18 +27,6 @@ import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId) pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData - --- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . --- The Cabal file is tracked. --- --- For an identifier complete with the hash use 'pkgUnitId' -pkgSimpleIdentifier :: Package -> Action String -pkgSimpleIdentifier package = do - cabal <- readPackageData package - return $ if null (version cabal) - then name cabal - else name cabal ++ "-" ++ version cabal - -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. pkgSynopsis :: Package -> Action String pkgSynopsis = fmap synopsis . readPackageData ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -345,7 +345,7 @@ registerPackage rs context = do pd <- packageDescription <$> readContextData context db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context)) dist_dir <- Context.buildPath context - pid <- pkgUnitId context + pid <- pkgUnitId context (package context) -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path -- from the local build info @lbi at . lbi <- liftIO $ C.getPersistBuildConfig cPath ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -6,7 +6,7 @@ module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where import Development.Shake -import Hadrian.Haskell.Cabal.Type +import Hadrian.Haskell.Cabal.Type as C import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal import Hadrian.Package @@ -35,8 +35,9 @@ import Control.Monad -- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd at . -- This needs to be an oracle so it's cached -pkgUnitId :: Context -> Action String -pkgUnitId ctx = do +pkgUnitId :: Context -> Package -> Action String +pkgUnitId ctx' pkg = do + let ctx = ctx'{package = pkg} pid <- pkgSimpleIdentifier (package ctx) phash <- pkgHash ctx -- Other boot packages still hardcode their unit-id to just , but we @@ -50,6 +51,16 @@ pkgUnitId ctx = do truncateHash :: Int -> String -> String truncateHash = take +-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . +-- The Cabal file is tracked. +-- +-- For an identifier complete with the hash use 'pkgUnitId' +pkgSimpleIdentifier :: Package -> Action String +pkgSimpleIdentifier package = do + cabal <- readPackageData package + return $ if null (version cabal) + then C.name cabal + else C.name cabal ++ "-" ++ version cabal data PackageHashInputs = PackageHashInputs { pkgHashPkgId :: String, -- ^ name-version ===================================== hadrian/src/Hadrian/Haskell/Hash.hs-boot ===================================== @@ -1,7 +1,8 @@ module Hadrian.Haskell.Hash where import Context.Type +import Hadrian.Package import Development.Shake -pkgUnitId :: Context -> Action String +pkgUnitId :: Context -> Package -> Action String ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,7 +132,7 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - rtsDir <- pkgSimpleIdentifier rts + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -10,7 +10,7 @@ import Utilities import qualified System.Directory.Extra as IO import Data.Either import Rules.BinaryDist -import Hadrian.Haskell.Cabal (pkgSimpleIdentifier) +import Hadrian.Haskell.Cabal (pkgUnitId) import Oracles.Setting {- @@ -54,7 +54,7 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - rtsDir <- pkgSimpleIdentifier rts + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -15,7 +15,6 @@ import Oracles.ModuleFiles import Oracles.Setting import Hadrian.Haskell.Cabal.Type (PackageData(version)) import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Hash import Hadrian.Oracles.Cabal (readPackageData) import Packages import Rules.Libffi @@ -495,7 +494,7 @@ generateConfigHs = do -- part of the WiringMap, so we don't to go back and forth between the -- unit-id and the unit-key -- we take care that they are the same by using -- 'pkgUnitId' to create the unit-id in both situations. - cProjectUnitId <- expr . pkgUnitId =<< getContext + cProjectUnitId <- expr . (`pkgUnitId` ghc) =<< getContext return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -183,7 +183,7 @@ buildConfFinal rs context at Context {..} _conf = do -- so that if any change ends up modifying a library (but not its .conf -- file), we still rebuild things that depend on it. dir <- (-/-) <$> libPath context <*> distDir stage - pkgid <- pkgSimpleIdentifier context + pkgid <- pkgUnitId context package files <- liftIO $ (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -86,7 +86,7 @@ commonCabalArgs stage = do verbosity <- expr getVerbosity ctx <- getContext pkg <- getPackage - package_id <- expr $ pkgSimpleIdentifier pkg + package_id <- expr $ pkgUnitId ctx pkg let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..") mconcat [ -- Don't strip libraries when cross compiling. -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -3,7 +3,6 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Hash import Hadrian.Haskell.Cabal.Type import Flavour @@ -15,7 +14,6 @@ import Rules.Libffi (libffiName) import qualified Data.Set as Set import System.Directory import Data.Version.Extra -import Hadrian.Haskell.Hash ghcBuilderArgs :: Args ghcBuilderArgs = mconcat @@ -262,7 +260,7 @@ packageGhcArgs = do -- building stage0 because we have a flag in compiler/ghc.cabal.in that is -- sets `-this-unit-id ghc` when hadrian is building stage0, which will -- overwrite this one. - pkgId <- expr $ pkgUnitId ctx + pkgId <- expr $ pkgUnitId ctx package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -42,7 +42,7 @@ haddockBuilderArgs = mconcat version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg haddocks <- expr $ haddockDependencies context - haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgSimpleIdentifier p | (p, h) <- haddocks] + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgUnitId context p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93a0c64803889fe71a4bbcd409f6bd7a611bb9a0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93a0c64803889fe71a4bbcd409f6bd7a611bb9a0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 15:34:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 20 Mar 2023 11:34:45 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 2 commits: compiler: Implement atomicSwapIORef with xchg Message-ID: <64187d1586dbf_90da34c2b4446380@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: 8fa3a169 by Ben Gamari at 2023-03-20T11:34:39-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - 3ecbf7a2 by Ben Gamari at 2023-03-20T11:34:39-04:00 testsuite: Add test for atomicSwapIORef# - - - - - 8 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/GHC/IORef.hs - + libraries/base/tests/AtomicSwapIORef.hs - libraries/base/tests/all.T - rts/PrimOps.cmm - rts/include/Cmm.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2464,6 +2464,13 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp + MutVar# s v -> v -> State# s -> (# State# s, v #) + {Atomically exchange the value of a 'MutVar#'.} + with + out_of_line = True + has_side_effects = True + -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1559,6 +1559,7 @@ emitPrimOp cfg primop = ResizeMutableByteArrayOp_Char -> alwaysExternal ShrinkSmallMutableArrayOp_Char -> alwaysExternal NewMutVarOp -> alwaysExternal + AtomicSwapMutVarOp -> alwaysExternal AtomicModifyMutVar2Op -> alwaysExternal AtomicModifyMutVar_Op -> alwaysExternal CasMutVarOp -> alwaysExternal ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -859,6 +859,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -127,12 +127,9 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a --- Bad implementation! This will be a primop shortly. atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicModifyMutVar2# ref (\_old -> Box new) s of - (# s', old, Box _new #) -> (# s', old #) - -data Box a = Box a + case atomicSwapMutVar# ref new s of + (# s', old #) -> (# s', old #) -- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both -- the value stored in the 'IORef' and the value returned. The new value ===================================== libraries/base/tests/AtomicSwapIORef.hs ===================================== @@ -0,0 +1,7 @@ +import Data.IORef + +main :: IO () +main = do + r <- newIORef 42 :: IO Int + atomicSwapIORef r 43 + readIORef r >>= print ===================================== libraries/base/tests/all.T ===================================== @@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('AtomicSwapIORef', normal, compile_and_run, ['']) ===================================== rts/PrimOps.cmm ===================================== @@ -689,6 +689,14 @@ stg_newMutVarzh ( gcptr init ) return (mv); } +stg_swapMutVarzh ( gcptr mv, gcptr old ) + /* MutVar# s a -> a -> State# s -> (# State#, a #) */ +{ + W_ new; + (new) = prim %xchgW(mv+OFFSET_StgMutVar_var, old); + return (new); +} + // RRN: To support the "ticketed" approach, we return the NEW rather // than old value if the CAS is successful. This is received in an // opaque form in the Haskell code, preventing the compiler from ===================================== rts/include/Cmm.h ===================================== @@ -193,8 +193,10 @@ #if SIZEOF_W == 4 #define cmpxchgW cmpxchg32 +#define xchgW xchg32 #elif SIZEOF_W == 8 #define cmpxchgW cmpxchg64 +#define xchgW xchg64 #endif /* ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b59504e25aa116639c467a391ec4e1d6149388c...3ecbf7a2672d72182c552c9ba9ffb45be68080af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b59504e25aa116639c467a391ec4e1d6149388c...3ecbf7a2672d72182c552c9ba9ffb45be68080af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 15:54:37 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 20 Mar 2023 11:54:37 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] If filepaths have hashes then cabal can't parse them Message-ID: <641881bd2da88_90da3abd72455945@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 66c4b329 by romes at 2023-03-20T15:54:06+00:00 If filepaths have hashes then cabal can't parse them - - - - - 12 changed files: - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Haskell/Hash.hs-boot - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Haddock.hs Changes: ===================================== hadrian/src/Context.hs ===================================== @@ -70,15 +70,15 @@ distDir st = do hostArch <- cabalArchString <$> setting arch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version -pkgFileName :: Package -> String -> String -> Action FilePath -pkgFileName package prefix suffix = do - pid <- pkgSimpleIdentifier package +pkgFileName :: Context -> Package -> String -> String -> Action FilePath +pkgFileName context package prefix suffix = do + pid <- pkgUnitId context package return $ prefix ++ pid ++ suffix pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - fileName <- pkgFileName package prefix suffix + fileName <- pkgFileName context package prefix suffix return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. @@ -95,9 +95,9 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile Context {..} = do +pkgHaddockFile context at Context {..} = do root <- buildRoot - version <- pkgSimpleIdentifier package + version <- pkgUnitId context package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: @@ -106,7 +106,7 @@ pkgHaddockFile Context {..} = do pkgRegisteredLibraryFile :: Context -> Action FilePath pkgRegisteredLibraryFile context at Context {..} = do libDir <- libPath context - pkgId <- pkgSimpleIdentifier package + pkgId <- pkgUnitId context package fileName <- pkgRegisteredLibraryFileName context distDir <- distDir stage return $ if Dynamic `wayUnit` way @@ -115,9 +115,9 @@ pkgRegisteredLibraryFile context at Context {..} = do -- | Just the final filename portion of pkgRegisteredLibraryFile pkgRegisteredLibraryFileName :: Context -> Action FilePath -pkgRegisteredLibraryFileName Context{..} = do +pkgRegisteredLibraryFileName context at Context{..} = do extension <- libsuf stage way - pkgFileName package "libHS" extension + pkgFileName context package "libHS" extension -- | Path to the library file of a given 'Context', e.g.: @@ -137,7 +137,7 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath pkgConfFile context at Context {..} = do - pid <- pkgSimpleIdentifier package + pid <- pkgUnitId context package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -10,7 +10,7 @@ -- Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( - pkgVersion, pkgSimpleIdentifier, pkgUnitId, pkgSynopsis, pkgDescription, + pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString ) where @@ -27,18 +27,6 @@ import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId) pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData - --- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . --- The Cabal file is tracked. --- --- For an identifier complete with the hash use 'pkgUnitId' -pkgSimpleIdentifier :: Package -> Action String -pkgSimpleIdentifier package = do - cabal <- readPackageData package - return $ if null (version cabal) - then name cabal - else name cabal ++ "-" ++ version cabal - -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. pkgSynopsis :: Package -> Action String pkgSynopsis = fmap synopsis . readPackageData ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -345,7 +345,7 @@ registerPackage rs context = do pd <- packageDescription <$> readContextData context db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context)) dist_dir <- Context.buildPath context - pid <- pkgUnitId context + pid <- pkgUnitId context (package context) -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path -- from the local build info @lbi at . lbi <- liftIO $ C.getPersistBuildConfig cPath ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -6,7 +6,7 @@ module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where import Development.Shake -import Hadrian.Haskell.Cabal.Type +import Hadrian.Haskell.Cabal.Type as C import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal import Hadrian.Package @@ -35,8 +35,9 @@ import Control.Monad -- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd at . -- This needs to be an oracle so it's cached -pkgUnitId :: Context -> Action String -pkgUnitId ctx = do +pkgUnitId :: Context -> Package -> Action String +pkgUnitId ctx' pkg = do + let ctx = ctx'{package = pkg} pid <- pkgSimpleIdentifier (package ctx) phash <- pkgHash ctx -- Other boot packages still hardcode their unit-id to just , but we @@ -50,6 +51,16 @@ pkgUnitId ctx = do truncateHash :: Int -> String -> String truncateHash = take +-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . +-- The Cabal file is tracked. +-- +-- For an identifier complete with the hash use 'pkgUnitId' +pkgSimpleIdentifier :: Package -> Action String +pkgSimpleIdentifier package = do + cabal <- readPackageData package + return $ if null (version cabal) + then C.name cabal + else C.name cabal ++ "-" ++ version cabal data PackageHashInputs = PackageHashInputs { pkgHashPkgId :: String, -- ^ name-version @@ -106,7 +117,7 @@ pkgHash = askOracle . PkgHashKey -- TODO: Needs to be oracle to be cached? Called lots of times pkgHashOracle :: Rules () pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do - ctx_data <- readContextData ctx + -- RECURSIVE ORACLE: ctx_data <- readContextData ctx pkg_data <- readPackageData (package ctx) name <- pkgSimpleIdentifier (package ctx) let stag = stage ctx @@ -141,8 +152,10 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do pkgHashStripLibs = False pkgHashDebugInfo = undefined - ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs - let pkgHashProgramArgs = Map.singleton "ghc" ghcArgs + liftIO $ print "HI" + -- ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs + liftIO $ print "HI" + let pkgHashProgramArgs = mempty -- Map.singleton "ghc" ghcArgs pkgHashExtraLibDirs = [] pkgHashExtraLibDirsStatic = [] pkgHashExtraFrameworkDirs = [] ===================================== hadrian/src/Hadrian/Haskell/Hash.hs-boot ===================================== @@ -1,7 +1,8 @@ module Hadrian.Haskell.Hash where import Context.Type +import Hadrian.Package import Development.Shake -pkgUnitId :: Context -> Action String +pkgUnitId :: Context -> Package -> Action String ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,7 +132,8 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - rtsDir <- pkgSimpleIdentifier rts + -- rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -10,7 +10,7 @@ import Utilities import qualified System.Directory.Extra as IO import Data.Either import Rules.BinaryDist -import Hadrian.Haskell.Cabal (pkgSimpleIdentifier) +import Hadrian.Haskell.Cabal (pkgUnitId) import Oracles.Setting {- @@ -54,7 +54,8 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - rtsDir <- pkgSimpleIdentifier rts + -- rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -15,7 +15,6 @@ import Oracles.ModuleFiles import Oracles.Setting import Hadrian.Haskell.Cabal.Type (PackageData(version)) import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Hash import Hadrian.Oracles.Cabal (readPackageData) import Packages import Rules.Libffi @@ -495,7 +494,7 @@ generateConfigHs = do -- part of the WiringMap, so we don't to go back and forth between the -- unit-id and the unit-key -- we take care that they are the same by using -- 'pkgUnitId' to create the unit-id in both situations. - cProjectUnitId <- expr . pkgUnitId =<< getContext + cProjectUnitId <- expr . (`pkgUnitId` ghc) =<< getContext return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -183,7 +183,7 @@ buildConfFinal rs context at Context {..} _conf = do -- so that if any change ends up modifying a library (but not its .conf -- file), we still rebuild things that depend on it. dir <- (-/-) <$> libPath context <*> distDir stage - pkgid <- pkgSimpleIdentifier context + pkgid <- pkgUnitId context package files <- liftIO $ (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -86,7 +86,7 @@ commonCabalArgs stage = do verbosity <- expr getVerbosity ctx <- getContext pkg <- getPackage - package_id <- expr $ pkgSimpleIdentifier pkg + package_id <- expr $ pkgUnitId ctx pkg let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..") mconcat [ -- Don't strip libraries when cross compiling. -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -3,7 +3,6 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Hash import Hadrian.Haskell.Cabal.Type import Flavour @@ -15,7 +14,6 @@ import Rules.Libffi (libffiName) import qualified Data.Set as Set import System.Directory import Data.Version.Extra -import Hadrian.Haskell.Hash ghcBuilderArgs :: Args ghcBuilderArgs = mconcat @@ -262,7 +260,7 @@ packageGhcArgs = do -- building stage0 because we have a flag in compiler/ghc.cabal.in that is -- sets `-this-unit-id ghc` when hadrian is building stage0, which will -- overwrite this one. - pkgId <- expr $ pkgUnitId ctx + pkgId <- expr $ pkgUnitId ctx package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -42,7 +42,7 @@ haddockBuilderArgs = mconcat version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg haddocks <- expr $ haddockDependencies context - haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgSimpleIdentifier p | (p, h) <- haddocks] + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgUnitId context p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66c4b329fa9c2767779d8b8f392cca5c44b1ff88 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66c4b329fa9c2767779d8b8f392cca5c44b1ff88 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 16:25:27 2023 From: gitlab at gitlab.haskell.org (ase (@adamse)) Date: Mon, 20 Mar 2023 12:25:27 -0400 Subject: [Git][ghc/ghc][wip/adamse/eventlog-docs] 4 commits: docs: explain the BLOCK_MARKER event Message-ID: <641888f72b17_90da4857e20679c4@gitlab.mail> ase pushed to branch wip/adamse/eventlog-docs at Glasgow Haskell Compiler / GHC Commits: 5e40c42d by Adam Sandberg Ericsson at 2023-03-20T16:25:11+00:00 docs: explain the BLOCK_MARKER event - - - - - 46bd3219 by Adam Sandberg Ericsson at 2023-03-20T16:25:11+00:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - a8ad190f by Adam Sandberg Ericsson at 2023-03-20T16:25:11+00:00 docs: add TASK_DELETE event in eventlog encodings - - - - - a7f675ff by Adam Sandberg Ericsson at 2023-03-20T16:25:11+00:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - 1 changed file: - docs/users_guide/eventlog-formats.rst Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -122,6 +122,18 @@ environment which the program is being run in. Describes the environment variables present in the program's environment. +.. event-type:: WALL_CLOCK_TIME + + :tag: 43 + :length: fixed + :field CapSetId: Capability set + :field Word64: Unix epoch seconds + :field Word32: Nanoseconds + + Records the wall clock time to make it possible to correlate events from + elsewhere with the eventlog. + + Thread and scheduling events ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -164,6 +176,7 @@ Thread and scheduling events * 12: BlockedOnSTM * 13: BlockedOnDoProc * 16: BlockedOnMsgThrowTo + * 20: BlockedOnMVarRead :field ThreadId: thread id of thread being blocked on (only for some status values) @@ -538,6 +551,15 @@ Task events Marks the migration of a task to a new capability. +.. event-type:: TASK_DELETE + + :tag: 57 + :length: fixed + :field TaskId: task id + + Marks the deletion of a task. + + Tracing events ~~~~~~~~~~~~~~ @@ -553,11 +575,12 @@ Tracing events :tag: 18 :length: fixed - :field Word32: size + :field Word32: block size :field Word64: end time in nanoseconds - :field Word16: capability number + :field Word16: capability number, invalid if ``0xffff``. - TODO + Marks a chunk of events. The events that fit in the next ``block size`` + bytes all belong to the block marker capability. .. event-type:: USER_MSG View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/50226c6d0ca087c182c072247895cf75ceea2a92...a7f675ff71bd38cf6cd325db7c82671107da6420 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/50226c6d0ca087c182c072247895cf75ceea2a92...a7f675ff71bd38cf6cd325db7c82671107da6420 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 16:26:33 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 20 Mar 2023 12:26:33 -0400 Subject: [Git][ghc/ghc][wip/T23134] Fix unification with oversaturated type families Message-ID: <641889399de48_90da46e559c685cf@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23134 at Glasgow Haskell Compiler / GHC Commits: 3e8e00c8 by Krzysztof Gogolewski at 2023-03-20T17:25:21+01:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - 4 changed files: - compiler/GHC/Core/Unify.hs - + testsuite/tests/simplCore/should_run/T23134.hs - + testsuite/tests/simplCore/should_run/T23134.stdout - testsuite/tests/simplCore/should_run/all.T Changes: ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1061,6 +1061,20 @@ unify_ty env ty1 ty2 _kco , um_unif env -- behaves like a type variable; might unify = maybeApart MARTypeFamily + -- An oversaturated type family can match a TyConApp, + -- this is handled the same way as in the AppTy case below (#23134) + | Just (tc1, _) <- mb_tc_app1 + , isTypeFamilyTyCon tc1 + , Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 + , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 + = unify_ty_app env ty1a [ty1b] ty2a [ty2b] + + | Just (tc2, _) <- mb_tc_app2 + , isTypeFamilyTyCon tc2 + , Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 + , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 + = unify_ty_app env ty1a [ty1b] ty2a [ty2b] + -- TYPE and CONSTRAINT are not Apart -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim -- NB: at this point we know that the two TyCons do not match ===================================== testsuite/tests/simplCore/should_run/T23134.hs ===================================== @@ -0,0 +1,37 @@ +{-# LANGUAGE GHC2021, DataKinds, TypeFamilies #-} +module Main where + +import Data.Maybe +import Data.Kind + +main :: IO () +main = putStrLn str + +str :: String +str = case runInstrImpl @(TOption TUnit) mm MAP of + C VOption -> "good" + C Unused -> "bad" + +runInstrImpl :: forall inp out. Value (MapOpRes inp TUnit) -> Instr inp out -> Rec out +runInstrImpl m MAP = C m + +type MapOpRes :: T -> T -> T +type family MapOpRes c :: T -> T +type instance MapOpRes ('TOption x) = 'TOption + +mm :: Value (TOption TUnit) +mm = VOption +{-# NOINLINE mm #-} + +type Value :: T -> Type +data Value t where + VOption :: Value ('TOption t) + Unused :: Value t + +data T = TOption T | TUnit + +data Instr (inp :: T) (out :: T) where + MAP :: Instr c (TOption (MapOpRes c TUnit)) + +data Rec :: T -> Type where + C :: Value r -> Rec (TOption r) ===================================== testsuite/tests/simplCore/should_run/T23134.stdout ===================================== @@ -0,0 +1 @@ +good ===================================== testsuite/tests/simplCore/should_run/all.T ===================================== @@ -109,4 +109,5 @@ 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']) +test('T23134', normal, compile_and_run, ['-O0 -fcatch-nonexhaustive-cases']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e8e00c85d8684cab84ffe8628f54105c0b2651c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e8e00c85d8684cab84ffe8628f54105c0b2651c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 17:07:34 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 20 Mar 2023 13:07:34 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] 3 commits: WIP: Better Hash Message-ID: <641892d6413c1_90da51e3fd4737e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 6a9bae2c by romes at 2023-03-20T17:06:51+00:00 WIP: Better Hash Co-author: @mpickering TODO: Fix identifier of rts which is depended on. What about the simple identifiers in haddocks? Perhaps we only need the full unitid for the pacckage databases. - - - - - cc53c5fb by romes at 2023-03-20T17:07:18+00:00 If filepaths have hashes then cabal can't parse them The wrong way to handle this. Reverting... - - - - - 4aab197e by romes at 2023-03-20T17:07:20+00:00 Revert "If filepaths have hashes then cabal can't parse them" This reverts commit 91d45aee4e3509fd258c498f5f19b0efedd58fbc. - - - - - 15 changed files: - hadrian/hadrian.cabal - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - + hadrian/src/Hadrian/Haskell/Hash.hs - + hadrian/src/Hadrian/Haskell/Hash.hs-boot - hadrian/src/Hadrian/Package.hs - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Haddock.hs Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -55,6 +55,7 @@ executable hadrian , Hadrian.BuildPath , Hadrian.Expression , Hadrian.Haskell.Cabal + , Hadrian.Haskell.Hash , Hadrian.Haskell.Cabal.Type , Hadrian.Haskell.Cabal.Parse , Hadrian.Oracles.ArgsHash @@ -163,6 +164,8 @@ executable hadrian , transformers >= 0.4 && < 0.7 , unordered-containers >= 0.2.1 && < 0.3 , text >= 1.2 && < 3 + , cryptohash-sha256 >= 0.11 && < 0.12 + , base16-bytestring >= 0.1.1 && < 1.1.0.0 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Context.hs ===================================== @@ -72,7 +72,7 @@ distDir st = do pkgFileName :: Package -> String -> String -> Action FilePath pkgFileName package prefix suffix = do - pid <- pkgIdentifier package + pid <- pkgSimpleIdentifier package return $ prefix ++ pid ++ suffix pkgFile :: Context -> String -> String -> Action FilePath @@ -97,7 +97,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") pkgHaddockFile :: Context -> Action FilePath pkgHaddockFile Context {..} = do root <- buildRoot - version <- pkgIdentifier package + version <- pkgSimpleIdentifier package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: @@ -106,7 +106,7 @@ pkgHaddockFile Context {..} = do pkgRegisteredLibraryFile :: Context -> Action FilePath pkgRegisteredLibraryFile context at Context {..} = do libDir <- libPath context - pkgId <- pkgIdentifier package + pkgId <- pkgSimpleIdentifier package fileName <- pkgRegisteredLibraryFileName context distDir <- distDir stage return $ if Dynamic `wayUnit` way @@ -136,8 +136,8 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile Context {..} = do - pid <- pkgIdentifier package +pkgConfFile context at Context {..} = do + pid <- pkgSimpleIdentifier package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -10,8 +10,8 @@ -- Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( - pkgVersion, pkgIdentifier, pkgSynopsis, pkgDescription, pkgDependencies, - pkgGenericDescription, cabalArchString, cabalOsString, + pkgVersion, pkgSimpleIdentifier, pkgUnitId, pkgSynopsis, pkgDescription, + pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString ) where import Development.Shake @@ -20,15 +20,20 @@ import Distribution.PackageDescription (GenericPackageDescription) import Hadrian.Haskell.Cabal.Type import Hadrian.Oracles.Cabal import Hadrian.Package +import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId) + -- | Read a Cabal file and return the package version. The Cabal file is tracked. pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData --- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0 at . + +-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . -- The Cabal file is tracked. -pkgIdentifier :: Package -> Action String -pkgIdentifier package = do +-- +-- For an identifier complete with the hash use 'pkgUnitId' +pkgSimpleIdentifier :: Package -> Action String +pkgSimpleIdentifier package = do cabal <- readPackageData package return $ if null (version cabal) then name cabal @@ -72,3 +77,4 @@ cabalOsString "mingw32" = "windows" cabalOsString "darwin" = "osx" cabalOsString "solaris2" = "solaris" cabalOsString other = other + ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -345,7 +345,7 @@ registerPackage rs context = do pd <- packageDescription <$> readContextData context db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context)) dist_dir <- Context.buildPath context - pid <- pkgIdentifier (package context) + pid <- pkgUnitId context -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path -- from the local build info @lbi at . lbi <- liftIO $ C.getPersistBuildConfig cPath ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -0,0 +1,229 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where + +import Development.Shake + +import Hadrian.Haskell.Cabal.Type +import Hadrian.Haskell.Cabal +import Hadrian.Oracles.Cabal +import Hadrian.Package + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as BS +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import Data.List +import Context.Type +import Oracles.Setting +import Hadrian.Target +import Hadrian.Expression +import Builder +import Flavour.Type +import Settings +import Way.Type +import Way +import Packages +import Development.Shake.Classes +import Control.Monad + + +-- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd at . +-- This needs to be an oracle so it's cached +pkgUnitId :: Context -> Action String +pkgUnitId ctx = do + pid <- pkgSimpleIdentifier (package ctx) + phash <- pkgHash ctx + -- Other boot packages still hardcode their unit-id to just , but we + -- can have hadrian generate a different unit-id for them just as cabal does + -- because the boot packages unit-ids are overriden by setting -this-unit-id + -- in the cabal file + liftIO $ print $ pid <> "-" <> truncateHash 4 phash + pure $ pid <> "-" <> truncateHash 4 phash + + where + truncateHash :: Int -> String -> String + truncateHash = take + + +data PackageHashInputs = PackageHashInputs { + pkgHashPkgId :: String, -- ^ name-version + pkgHashComponent :: PackageType, + pkgHashSourceHash :: BS.ByteString, + -- pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion), + pkgHashDirectDeps :: Set.Set String, + pkgHashOtherConfig :: PackageHashConfigInputs + } + +-- | Those parts of the package configuration that contribute to the +-- package hash computed by hadrian (which is simpler than cabal's). +-- +-- setting in Oracle.setting, which come from system.config +data PackageHashConfigInputs = PackageHashConfigInputs { + pkgHashCompilerId :: String, + pkgHashPlatform :: String, + pkgHashFlagAssignment :: [String], -- complete not partial + -- pkgHashConfigureScriptArgs :: [String], -- just ./configure for build-type Configure + pkgHashVanillaLib :: Bool, + pkgHashSharedLib :: Bool, + pkgHashDynExe :: Bool, + pkgHashFullyStaticExe :: Bool, + pkgHashGHCiLib :: Bool, + pkgHashProfLib :: Bool, + pkgHashProfExe :: Bool, +-- pkgHashProfLibDetail :: ProfDetailLevel, +-- pkgHashProfExeDetail :: ProfDetailLevel, + pkgHashCoverage :: Bool, + pkgHashOptimization :: Int, + pkgHashSplitObjs :: Bool, + pkgHashSplitSections :: Bool, + pkgHashStripLibs :: Bool, + pkgHashStripExes :: Bool, +-- pkgHashDebugInfo :: DebugInfoLevel, + pkgHashProgramArgs :: Map String [String], + pkgHashExtraLibDirs :: [FilePath], + pkgHashExtraLibDirsStatic :: [FilePath], + pkgHashExtraFrameworkDirs :: [FilePath], + pkgHashExtraIncludeDirs :: [FilePath] + -- pkgHashProgPrefix :: Maybe PathTemplate, + -- pkgHashProgSuffix :: Maybe PathTemplate, + -- pkgHashPackageDbs :: [Maybe PackageDB] + } + deriving Show + +newtype PkgHashKey = PkgHashKey Context + deriving (Binary, Eq, Hashable, NFData, Show, Typeable) +type instance RuleResult PkgHashKey = String + +pkgHash :: Context -> Action String +pkgHash = askOracle . PkgHashKey + +-- TODO: Needs to be oracle to be cached? Called lots of times +pkgHashOracle :: Rules () +pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do + ctx_data <- readContextData ctx + pkg_data <- readPackageData (package ctx) + name <- pkgSimpleIdentifier (package ctx) + let stag = stage ctx + liftIO $ print ("Package and Package Dependencies", package ctx, packageDependencies pkg_data) + stagePkgs <- stagePackages stag + depsHashes <- mapM (\pkg -> pkgHash (ctx { package = pkg })) [pkg | pkg <- packageDependencies pkg_data, pkg `elem` stagePkgs] + liftIO $ print ("Pkg Deps Hashes", depsHashes) + flav <- flavour + let flavourArgs = args flav + + targetOs <- setting TargetOs + let pkgHashCompilerId = "" + pkgHashPlatform = targetOs + libWays <- interpretInContext ctx (libraryWays flav) + dyn_ghc <- dynamicGhcPrograms flav + flags <- interpret (target ctx (Cabal Flags stag) [] []) flavourArgs + let pkgHashFlagAssignment = flags + pkgHashConfigureScriptArgs = "" + pkgHashVanillaLib = vanilla `Set.member` libWays + pkgHashSharedLib = dynamic `Set.member` libWays + pkgHashDynExe = dyn_ghc + -- TODO: fullyStatic flavour transformer + pkgHashFullyStaticExe = False + pkgHashGHCiLib = False + pkgHashProfLib = profiling `Set.member` libWays + pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag + pkgHashCoverage = False -- Can't configure this + pkgHashOptimization = 0 -- TODO: A bit tricky to configure + pkgHashSplitObjs = False -- Deprecated + pkgHashSplitSections = ghcSplitSections flav + pkgHashStripExes = False + pkgHashStripLibs = False + pkgHashDebugInfo = undefined + + ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs + let pkgHashProgramArgs = Map.singleton "ghc" ghcArgs + pkgHashExtraLibDirs = [] + pkgHashExtraLibDirsStatic = [] + pkgHashExtraFrameworkDirs = [] + pkgHashExtraIncludeDirs = [] + + let other_config = PackageHashConfigInputs{..} + + return $ BS.unpack $ Base16.encode $ SHA256.hash $ + renderPackageHashInputs $ PackageHashInputs + { + pkgHashPkgId = name + , pkgHashComponent = pkgType (package ctx) + , pkgHashSourceHash = "" + , pkgHashDirectDeps = Set.empty + , pkgHashOtherConfig = other_config + } + +prettyShow, showHashValue :: Show a => a -> String +prettyShow = show +showHashValue = show + +renderPackageHashInputs :: PackageHashInputs -> BS.ByteString +renderPackageHashInputs PackageHashInputs{ + pkgHashPkgId, + pkgHashComponent, + pkgHashSourceHash, + pkgHashDirectDeps, + -- pkgHashPkgConfigDeps, + pkgHashOtherConfig = + PackageHashConfigInputs{..} + } = + -- The purpose of this somewhat laboured rendering (e.g. why not just + -- use show?) is so that existing package hashes do not change + -- unnecessarily when new configuration inputs are added into the hash. + BS.pack $ unlines $ catMaybes $ + [ entry "pkgid" prettyShow pkgHashPkgId +-- , mentry "component" show pkgHashComponent + , entry "src" showHashValue pkgHashSourceHash + {- + , entry "pkg-config-deps" + (intercalate ", " . map (\(pn, mb_v) -> prettyShow pn ++ + case mb_v of + Nothing -> "" + Just v -> " " ++ prettyShow v) + . Set.toList) pkgHashPkgConfigDeps + -} + , entry "deps" (intercalate ", " . map prettyShow + . Set.toList) pkgHashDirectDeps + -- and then all the config + , entry "compilerid" prettyShow pkgHashCompilerId + , entry "platform" prettyShow pkgHashPlatform + , opt "flags" mempty show pkgHashFlagAssignment +-- , opt "configure-script" [] unwords pkgHashConfigureScriptArgs + , opt "vanilla-lib" True prettyShow pkgHashVanillaLib + , opt "shared-lib" False prettyShow pkgHashSharedLib + , opt "dynamic-exe" False prettyShow pkgHashDynExe + , opt "fully-static-exe" False prettyShow pkgHashFullyStaticExe + , opt "ghci-lib" False prettyShow pkgHashGHCiLib + , opt "prof-lib" False prettyShow pkgHashProfLib + , opt "prof-exe" False prettyShow pkgHashProfExe + -- , opt "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail + -- , opt "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail + , opt "hpc" False prettyShow pkgHashCoverage + , opt "optimisation" 0 (show) pkgHashOptimization + , opt "split-objs" False prettyShow pkgHashSplitObjs + , opt "split-sections" False prettyShow pkgHashSplitSections + , opt "stripped-lib" False prettyShow pkgHashStripLibs + , opt "stripped-exe" True prettyShow pkgHashStripExes +-- , opt "debug-info" NormalDebugInfo (show . fromEnum) pkgHashDebugInfo + , opt "extra-lib-dirs" [] unwords pkgHashExtraLibDirs + , opt "extra-lib-dirs-static" [] unwords pkgHashExtraLibDirsStatic + , opt "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs + , opt "extra-include-dirs" [] unwords pkgHashExtraIncludeDirs +-- , opt "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix +-- , opt "prog-suffix" Nothing (maybe "" fromPathTemplate) pkgHashProgSuffix +-- , opt "package-dbs" [] (unwords . map show) pkgHashPackageDbs + + ] ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs + where + entry key format value = Just (key ++ ": " ++ format value) + mentry key format value = fmap (\v -> key ++ ": " ++ format v) value + opt key def format value + | value == def = Nothing + | otherwise = entry key format value ===================================== hadrian/src/Hadrian/Haskell/Hash.hs-boot ===================================== @@ -0,0 +1,7 @@ +module Hadrian.Haskell.Hash where + +import Context.Type +import Development.Shake + +pkgUnitId :: Context -> Action String + ===================================== hadrian/src/Hadrian/Package.hs ===================================== @@ -81,4 +81,4 @@ instance NFData PackageType instance Binary Package instance Hashable Package -instance NFData Package \ No newline at end of file +instance NFData Package ===================================== hadrian/src/Rules.hs ===================================== @@ -8,6 +8,7 @@ import qualified Hadrian.Oracles.Cabal.Rules import qualified Hadrian.Oracles.DirectoryContents import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile +import qualified Hadrian.Haskell.Hash import Expression import qualified Oracles.Flavour @@ -142,6 +143,7 @@ oracleRules :: Rules () oracleRules = do Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs Hadrian.Oracles.Cabal.Rules.cabalOracle + Hadrian.Haskell.Hash.pkgHashOracle Hadrian.Oracles.DirectoryContents.directoryContentsOracle Hadrian.Oracles.Path.pathOracle Hadrian.Oracles.TextFile.textFileOracle ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,7 +132,7 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgSimpleIdentifier rts let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -10,7 +10,7 @@ import Utilities import qualified System.Directory.Extra as IO import Data.Either import Rules.BinaryDist -import Hadrian.Haskell.Cabal (pkgIdentifier) +import Hadrian.Haskell.Cabal (pkgSimpleIdentifier) import Oracles.Setting {- @@ -54,7 +54,7 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgSimpleIdentifier rts let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -14,6 +14,8 @@ import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting import Hadrian.Haskell.Cabal.Type (PackageData(version)) +import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Hash import Hadrian.Oracles.Cabal (readPackageData) import Packages import Rules.Libffi @@ -486,16 +488,14 @@ generateConfigHs = do trackGenerateHs cProjectName <- getSetting ProjectName cBooterVersion <- getSetting GhcVersion - cProjectVersionMunged <- getSetting ProjectVersionMunged - -- ROMES:TODO:HASH First we attempt a fixed unit-id with version but without hash. - -- - -- We now use a more informative unit-id for ghc. See Note [GHC's Unit Id] - -- in GHC.Unit.Types + -- We now give a unit-id with a version and a hash to ghc. + -- See Note [GHC's Unit Id] in GHC.Unit.Types -- -- It's crucial that the unit-id matches the unit-key -- ghc is no longer -- part of the WiringMap, so we don't to go back and forth between the - -- unit-id and the unit-key -- we take care here that they are the same. - let cProjectUnitId = "ghc-" ++ cProjectVersionMunged -- ROMES:TODO:HASH + -- unit-id and the unit-key -- we take care that they are the same by using + -- 'pkgUnitId' to create the unit-id in both situations. + cProjectUnitId <- expr . pkgUnitId =<< getContext return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -592,3 +592,5 @@ generatePlatformHostHs = do , "hostPlatformArchOS :: ArchOS" , "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS" ] + + ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -183,7 +183,7 @@ buildConfFinal rs context at Context {..} _conf = do -- so that if any change ends up modifying a library (but not its .conf -- file), we still rebuild things that depend on it. dir <- (-/-) <$> libPath context <*> distDir stage - pkgid <- pkgIdentifier package + pkgid <- pkgSimpleIdentifier context files <- liftIO $ (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -84,8 +84,9 @@ cabalSetupArgs = builder (Cabal Setup) ? do commonCabalArgs :: Stage -> Args commonCabalArgs stage = do verbosity <- expr getVerbosity + ctx <- getContext pkg <- getPackage - package_id <- expr $ pkgIdentifier pkg + package_id <- expr $ pkgSimpleIdentifier pkg let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..") mconcat [ -- Don't strip libraries when cross compiling. -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -3,6 +3,7 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Hash import Hadrian.Haskell.Cabal.Type import Flavour @@ -14,6 +15,7 @@ import Rules.Libffi (libffiName) import qualified Data.Set as Set import System.Directory import Data.Version.Extra +import Hadrian.Haskell.Hash ghcBuilderArgs :: Args ghcBuilderArgs = mconcat @@ -243,21 +245,24 @@ wayGhcArgs = do , (way == debug || way == debugDynamic) ? pure ["-ticky", "-DTICKY_TICKY"] ] +-- | Args related to correct handling of packages, such as setting +-- -this-unit-id and passing -package-id for dependencies packageGhcArgs :: Args packageGhcArgs = do package <- getPackage + ctx <- getContext ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) -- ROMES: Until the boot compiler no longer needs ghc's -- unit-id to be "ghc", the stage0 compiler must be built -- with `-this-unit-id ghc`, while the wired-in unit-id of -- ghc is correctly set to the unit-id we'll generate for - -- stage1 (set in generateVersionHs in Rules.Generate). + -- stage1 (set in generateConfigHs in Rules.Generate). -- -- However, we don't need to set the unit-id of "ghc" to "ghc" when -- building stage0 because we have a flag in compiler/ghc.cabal.in that is -- sets `-this-unit-id ghc` when hadrian is building stage0, which will -- overwrite this one. - pkgId <- expr $ pkgIdentifier package + pkgId <- expr $ pkgUnitId ctx mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -42,7 +42,7 @@ haddockBuilderArgs = mconcat version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg haddocks <- expr $ haddockDependencies context - haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks] + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgSimpleIdentifier p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/66c4b329fa9c2767779d8b8f392cca5c44b1ff88...4aab197ed680cc5d192c4845c009c4bd1871535e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/66c4b329fa9c2767779d8b8f392cca5c44b1ff88...4aab197ed680cc5d192c4845c009c4bd1871535e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 17:35:18 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 20 Mar 2023 13:35:18 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] Revert "Revert "If filepaths have hashes then cabal can't parse them"" Message-ID: <64189956ba69f_90da5a5beb476125@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 75a2f1fd by romes at 2023-03-20T17:35:05+00:00 Revert "Revert "If filepaths have hashes then cabal can't parse them"" This reverts commit 4aab197ed680cc5d192c4845c009c4bd1871535e. - - - - - 15 changed files: - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Haskell/Hash.hs-boot - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Haddock.hs Changes: ===================================== hadrian/src/Context.hs ===================================== @@ -70,15 +70,15 @@ distDir st = do hostArch <- cabalArchString <$> setting arch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version -pkgFileName :: Package -> String -> String -> Action FilePath -pkgFileName package prefix suffix = do - pid <- pkgSimpleIdentifier package +pkgFileName :: Context -> Package -> String -> String -> Action FilePath +pkgFileName context package prefix suffix = do + pid <- pkgUnitId context package return $ prefix ++ pid ++ suffix pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - fileName <- pkgFileName package prefix suffix + fileName <- pkgFileName context package prefix suffix return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. @@ -95,9 +95,9 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile Context {..} = do +pkgHaddockFile context at Context {..} = do root <- buildRoot - version <- pkgSimpleIdentifier package + version <- pkgUnitId context package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: @@ -106,7 +106,7 @@ pkgHaddockFile Context {..} = do pkgRegisteredLibraryFile :: Context -> Action FilePath pkgRegisteredLibraryFile context at Context {..} = do libDir <- libPath context - pkgId <- pkgSimpleIdentifier package + pkgId <- pkgUnitId context package fileName <- pkgRegisteredLibraryFileName context distDir <- distDir stage return $ if Dynamic `wayUnit` way @@ -115,9 +115,9 @@ pkgRegisteredLibraryFile context at Context {..} = do -- | Just the final filename portion of pkgRegisteredLibraryFile pkgRegisteredLibraryFileName :: Context -> Action FilePath -pkgRegisteredLibraryFileName Context{..} = do +pkgRegisteredLibraryFileName context at Context{..} = do extension <- libsuf stage way - pkgFileName package "libHS" extension + pkgFileName context package "libHS" extension -- | Path to the library file of a given 'Context', e.g.: @@ -137,7 +137,7 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath pkgConfFile context at Context {..} = do - pid <- pkgSimpleIdentifier package + pid <- pkgUnitId context package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -112,16 +112,19 @@ parseWayUnit = Parsec.choice -- | Parse a @"pkgname-pkgversion"@ string into the package name and the -- integers that make up the package version. -parsePkgId :: Parsec.Parsec String () (String, [Integer]) +parsePkgId :: Parsec.Parsec String () (String, [Integer], String) parsePkgId = parsePkgId' "" Parsec. "package identifier (-)" where parsePkgId' currName = do s <- Parsec.many1 Parsec.alphaNum _ <- Parsec.char '-' let newName = if null currName then s else currName ++ "-" ++ s - Parsec.choice [ (newName,) <$> parsePkgVersion + Parsec.choice [ (,,) newName <$> parsePkgVersion <*> (Parsec.char '-' *> parsePkgHash) , parsePkgId' newName ] +parsePkgHash :: Parsec.Parsec String () String +parsePkgHash = Parsec.many1 Parsec.alphaNum + -- | Parse "."-separated integers that describe a package's version. parsePkgVersion :: Parsec.Parsec String () [Integer] parsePkgVersion = fmap reverse (parsePkgVersion' []) ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -10,7 +10,7 @@ -- Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( - pkgVersion, pkgSimpleIdentifier, pkgUnitId, pkgSynopsis, pkgDescription, + pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString ) where @@ -27,18 +27,6 @@ import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId) pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData - --- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . --- The Cabal file is tracked. --- --- For an identifier complete with the hash use 'pkgUnitId' -pkgSimpleIdentifier :: Package -> Action String -pkgSimpleIdentifier package = do - cabal <- readPackageData package - return $ if null (version cabal) - then name cabal - else name cabal ++ "-" ++ version cabal - -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. pkgSynopsis :: Package -> Action String pkgSynopsis = fmap synopsis . readPackageData ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -345,7 +345,7 @@ registerPackage rs context = do pd <- packageDescription <$> readContextData context db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context)) dist_dir <- Context.buildPath context - pid <- pkgUnitId context + pid <- pkgUnitId context (package context) -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path -- from the local build info @lbi at . lbi <- liftIO $ C.getPersistBuildConfig cPath ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -6,7 +6,7 @@ module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where import Development.Shake -import Hadrian.Haskell.Cabal.Type +import Hadrian.Haskell.Cabal.Type as C import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal import Hadrian.Package @@ -35,8 +35,9 @@ import Control.Monad -- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd at . -- This needs to be an oracle so it's cached -pkgUnitId :: Context -> Action String -pkgUnitId ctx = do +pkgUnitId :: Context -> Package -> Action String +pkgUnitId ctx' pkg = do + let ctx = ctx'{package = pkg} pid <- pkgSimpleIdentifier (package ctx) phash <- pkgHash ctx -- Other boot packages still hardcode their unit-id to just , but we @@ -50,6 +51,16 @@ pkgUnitId ctx = do truncateHash :: Int -> String -> String truncateHash = take +-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . +-- The Cabal file is tracked. +-- +-- For an identifier complete with the hash use 'pkgUnitId' +pkgSimpleIdentifier :: Package -> Action String +pkgSimpleIdentifier package = do + cabal <- readPackageData package + return $ if null (version cabal) + then C.name cabal + else C.name cabal ++ "-" ++ version cabal data PackageHashInputs = PackageHashInputs { pkgHashPkgId :: String, -- ^ name-version @@ -106,7 +117,7 @@ pkgHash = askOracle . PkgHashKey -- TODO: Needs to be oracle to be cached? Called lots of times pkgHashOracle :: Rules () pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do - ctx_data <- readContextData ctx + -- RECURSIVE ORACLE: ctx_data <- readContextData ctx pkg_data <- readPackageData (package ctx) name <- pkgSimpleIdentifier (package ctx) let stag = stage ctx @@ -141,8 +152,10 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do pkgHashStripLibs = False pkgHashDebugInfo = undefined - ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs - let pkgHashProgramArgs = Map.singleton "ghc" ghcArgs + liftIO $ print "HI" + -- ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs + liftIO $ print "HI" + let pkgHashProgramArgs = mempty -- Map.singleton "ghc" ghcArgs pkgHashExtraLibDirs = [] pkgHashExtraLibDirsStatic = [] pkgHashExtraFrameworkDirs = [] ===================================== hadrian/src/Hadrian/Haskell/Hash.hs-boot ===================================== @@ -1,7 +1,8 @@ module Hadrian.Haskell.Hash where import Context.Type +import Hadrian.Package import Development.Shake -pkgUnitId :: Context -> Action String +pkgUnitId :: Context -> Package -> Action String ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,7 +132,8 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - rtsDir <- pkgSimpleIdentifier rts + -- rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -10,7 +10,7 @@ import Utilities import qualified System.Directory.Extra as IO import Data.Either import Rules.BinaryDist -import Hadrian.Haskell.Cabal (pkgSimpleIdentifier) +import Hadrian.Haskell.Cabal (pkgUnitId) import Oracles.Setting {- @@ -54,7 +54,8 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - rtsDir <- pkgSimpleIdentifier rts + -- rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -293,7 +293,7 @@ parsePkgDocTarget root = do _ <- Parsec.string root *> Parsec.optional (Parsec.char '/') _ <- Parsec.string (htmlRoot ++ "/") _ <- Parsec.string "libraries/" - (pkgname, _) <- parsePkgId <* Parsec.char '/' + (pkgname, _, _) <- parsePkgId <* Parsec.char '/' Parsec.choice [ Parsec.try (Parsec.string "haddock-prologue.txt") *> pure (HaddockPrologue pkgname) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -15,7 +15,6 @@ import Oracles.ModuleFiles import Oracles.Setting import Hadrian.Haskell.Cabal.Type (PackageData(version)) import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Hash import Hadrian.Oracles.Cabal (readPackageData) import Packages import Rules.Libffi @@ -495,7 +494,7 @@ generateConfigHs = do -- part of the WiringMap, so we don't to go back and forth between the -- unit-id and the unit-key -- we take care that they are the same by using -- 'pkgUnitId' to create the unit-id in both situations. - cProjectUnitId <- expr . pkgUnitId =<< getContext + cProjectUnitId <- expr . (`pkgUnitId` ghc) =<< getContext return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -45,7 +45,7 @@ libraryRules = do registerStaticLib :: FilePath -> FilePath -> Action () registerStaticLib root archivePath = do -- Simply need the ghc-pkg database .conf file. - GhcPkgPath _ stage _ (LibA name _ w) + GhcPkgPath _ stage _ (LibA name _ _ w) <- parsePath (parseGhcPkgLibA root) "<.a library (register) path parser>" archivePath @@ -56,7 +56,7 @@ registerStaticLib root archivePath = do -- the second argument. buildStaticLib :: FilePath -> FilePath -> Action () buildStaticLib root archivePath = do - l@(BuildPath _ stage _ (LibA pkgname _ way)) + l@(BuildPath _ stage _ (LibA pkgname _ _ way)) <- parsePath (parseBuildLibA root) "<.a library (build) path parser>" archivePath @@ -75,7 +75,7 @@ buildStaticLib root archivePath = do registerDynamicLib :: FilePath -> String -> FilePath -> Action () registerDynamicLib root suffix dynlibpath = do -- Simply need the ghc-pkg database .conf file. - (GhcPkgPath _ stage _ (LibDyn name _ w _)) + (GhcPkgPath _ stage _ (LibDyn name _ _ w _)) <- parsePath (parseGhcPkgLibDyn root suffix) "" dynlibpath @@ -99,7 +99,7 @@ buildDynamicLib root suffix dynlibpath = do -- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. buildGhciLibO :: FilePath -> FilePath -> Action () buildGhciLibO root ghcilibPath = do - l@(BuildPath _ stage _ (LibGhci _ _ _)) + l@(BuildPath _ stage _ (LibGhci _ _ _ _)) <- parsePath (parseBuildLibGhci root) "<.o ghci lib (build) path parser>" ghcilibPath @@ -134,7 +134,7 @@ files etc. buildPackage :: FilePath -> FilePath -> Action () buildPackage root fp = do - l@(BuildPath _ _ _ (PkgStamp _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp + l@(BuildPath _ _ _ (PkgStamp _ _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp let ctx = stampContext l srcs <- hsSources ctx gens <- interpretInContext ctx generatedDependencies @@ -226,47 +226,47 @@ needLibrary cs = need =<< concatMapM (libraryTargets True) cs -- * Library paths types and parsers --- | > libHS-[_].a -data LibA = LibA String [Integer] Way deriving (Eq, Show) +-- | > libHS--[_].a +data LibA = LibA String [Integer] String Way deriving (Eq, Show) -- | > data DynLibExt = So | Dylib deriving (Eq, Show) --- | > libHS-[_]-ghc. -data LibDyn = LibDyn String [Integer] Way DynLibExt deriving (Eq, Show) +-- | > libHS--[_]-ghc. +data LibDyn = LibDyn String [Integer] String Way DynLibExt deriving (Eq, Show) --- | > HS-[_].o -data LibGhci = LibGhci String [Integer] Way deriving (Eq, Show) +-- | > HS--[_].o +data LibGhci = LibGhci String [Integer] String Way deriving (Eq, Show) -- | Get the 'Context' corresponding to the build path for a given static library. libAContext :: BuildPath LibA -> Context -libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) = +libAContext (BuildPath _ stage pkgpath (LibA pkgname _ _ way)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given GHCi library. libGhciContext :: BuildPath LibGhci -> Context -libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) = +libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ _ way)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given dynamic library. libDynContext :: BuildPath LibDyn -> Context -libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = +libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ _ way _)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given static library. stampContext :: BuildPath PkgStamp -> Context -stampContext (BuildPath _ stage _ (PkgStamp pkgname _ way)) = +stampContext (BuildPath _ stage _ (PkgStamp pkgname _ _ way)) = Context stage pkg way Final where pkg = unsafeFindPackageByName pkgname -data PkgStamp = PkgStamp String [Integer] Way deriving (Eq, Show) +data PkgStamp = PkgStamp String [Integer] String Way deriving (Eq, Show) -- | Parse a path to a ghci library to be built, making sure the path starts @@ -313,34 +313,34 @@ parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext) parseLibAFilename :: Parsec.Parsec String () LibA parseLibAFilename = do _ <- Parsec.string "libHS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- parseWaySuffix vanilla _ <- Parsec.string ".a" - return (LibA pkgname pkgver way) + return (LibA pkgname pkgver pkghash way) -- | Parse the filename of a ghci library to be built into a 'LibGhci' value. parseLibGhciFilename :: Parsec.Parsec String () LibGhci parseLibGhciFilename = do _ <- Parsec.string "HS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId _ <- Parsec.string "." way <- parseWayPrefix vanilla _ <- Parsec.string "o" - return (LibGhci pkgname pkgver way) + return (LibGhci pkgname pkgver pkghash way) -- | Parse the filename of a dynamic library to be built into a 'LibDyn' value. parseLibDynFilename :: String -> Parsec.Parsec String () LibDyn parseLibDynFilename ext = do _ <- Parsec.string "libHS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- addWayUnit Dynamic <$> parseWaySuffix dynamic _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion _ <- Parsec.string ("." ++ ext) - return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) + return (LibDyn pkgname pkgver pkghash way $ if ext == "so" then So else Dylib) parseStamp :: Parsec.Parsec String () PkgStamp parseStamp = do _ <- Parsec.string "stamp-" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- parseWaySuffix vanilla - return (PkgStamp pkgname pkgver way) + return (PkgStamp pkgname pkgver pkghash way) ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeApplications #-} module Rules.Register ( configurePackageRules, registerPackageRules, registerPackages, libraryTargets @@ -20,11 +21,15 @@ import Utilities import Hadrian.Haskell.Cabal.Type import qualified Text.Parsec as Parsec import qualified Data.Set as Set +import qualified Data.Char as Char +import Data.Bifunctor (bimap) import Distribution.Version (Version) -import qualified Distribution.Parsec as Cabal -import qualified Distribution.Types.PackageName as Cabal import qualified Distribution.Types.PackageId as Cabal +import qualified Distribution.Types.PackageName as Cabal +import qualified Distribution.Parsec as Cabal +import qualified Distribution.Parsec.FieldLineStream as Cabal +import qualified Distribution.Compat.CharParsing as CabalCharParsing import qualified Hadrian.Haskell.Cabal.Parse as Cabal import qualified System.Directory as IO @@ -183,7 +188,7 @@ buildConfFinal rs context at Context {..} _conf = do -- so that if any change ends up modifying a library (but not its .conf -- file), we still rebuild things that depend on it. dir <- (-/-) <$> libPath context <*> distDir stage - pkgid <- pkgSimpleIdentifier context + pkgid <- pkgUnitId context package files <- liftIO $ (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] @@ -193,7 +198,9 @@ buildConfInplace :: [(Resource, Int)] -> Context -> FilePath -> Action () buildConfInplace rs context at Context {..} _conf = do depPkgIds <- cabalDependencies context ensureConfigured context + liftIO $ print "OK1" need =<< mapM (\pkgId -> packageDbPath (PackageDbLoc stage Inplace) <&> (-/- pkgId <.> "conf")) depPkgIds + liftIO $ print "OK2" path <- buildPath context @@ -251,11 +258,32 @@ getPackageNameFromConfFile conf takeBaseName conf ++ ": " ++ err Right (name, _) -> return name +-- | Parse a cabal-like name parseCabalName :: String -> Either String (String, Version) -parseCabalName = fmap f . Cabal.eitherParsec +-- Try to parse a name with a hash, but otherwise parse a name without one. +parseCabalName s = bimap show id (Cabal.runParsecParser nameWithHashParser "" $ Cabal.fieldLineStreamFromString s) + <|> fmap f (Cabal.eitherParsec s) where f :: Cabal.PackageId -> (String, Version) f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id) + -- Definition similar to 'Parsec PackageIdentifier' from Cabal but extended + -- with logic for parsing the hash (despite not returning it) + nameWithHashParser :: Cabal.ParsecParser (String, Version) + nameWithHashParser = Cabal.PP $ \_ -> do + xs' <- Parsec.sepBy component (Parsec.char '-') + case reverse xs' of + hash:version_str:xs -> + case Cabal.simpleParsec @Version version_str of + Nothing -> fail ("failed to parse a version from " <> version_str) + Just v -> + if not (null xs) && all (\c -> all (/= '.') c && not (all Char.isDigit c)) xs + then return $ (intercalate "-" (reverse xs), v) + else fail "all digits or a dot in a portion of package name" + _ -> fail "couldn't parse a hash, a version and a name" + where + component = CabalCharParsing.munch1 (\c -> Char.isAlphaNum c || c == '.') + + -- | Return extra library targets. extraTargets :: Context -> Action [FilePath] ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -86,7 +86,7 @@ commonCabalArgs stage = do verbosity <- expr getVerbosity ctx <- getContext pkg <- getPackage - package_id <- expr $ pkgSimpleIdentifier pkg + package_id <- expr $ pkgUnitId ctx pkg let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..") mconcat [ -- Don't strip libraries when cross compiling. -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -3,7 +3,6 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Hash import Hadrian.Haskell.Cabal.Type import Flavour @@ -15,7 +14,6 @@ import Rules.Libffi (libffiName) import qualified Data.Set as Set import System.Directory import Data.Version.Extra -import Hadrian.Haskell.Hash ghcBuilderArgs :: Args ghcBuilderArgs = mconcat @@ -262,7 +260,7 @@ packageGhcArgs = do -- building stage0 because we have a flag in compiler/ghc.cabal.in that is -- sets `-this-unit-id ghc` when hadrian is building stage0, which will -- overwrite this one. - pkgId <- expr $ pkgUnitId ctx + pkgId <- expr $ pkgUnitId ctx package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -42,7 +42,7 @@ haddockBuilderArgs = mconcat version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg haddocks <- expr $ haddockDependencies context - haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgSimpleIdentifier p | (p, h) <- haddocks] + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgUnitId context p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/75a2f1fd30a499d41b6eead5b8143f030653d04e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/75a2f1fd30a499d41b6eead5b8143f030653d04e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 18:22:16 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 20 Mar 2023 14:22:16 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] 122 commits: Don't specialise incoherent instance applications Message-ID: <6418a458db0b8_90da671ef98804e1@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - 856c78e7 by romes at 2023-03-20T18:20:47+00:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - aed85345 by romes at 2023-03-20T18:20:47+00:00 Validate compatibility of ghcs when loading plugins - - - - - f8614431 by romes at 2023-03-20T18:20:47+00:00 WIP: Better Hash Co-author: @mpickering TODO: Fix identifier of rts which is depended on. What about the simple identifiers in haddocks? Perhaps we only need the full unitid for the pacckage databases. - - - - - 1e0dedae by romes at 2023-03-20T18:20:47+00:00 If filepaths have hashes then cabal can't parse them The wrong way to handle this. Reverting... - - - - - 983c9968 by romes at 2023-03-20T18:20:47+00:00 Revert "If filepaths have hashes then cabal can't parse them" This reverts commit 91d45aee4e3509fd258c498f5f19b0efedd58fbc. - - - - - ae627b13 by romes at 2023-03-20T18:20:47+00:00 Revert "Revert "If filepaths have hashes then cabal can't parse them"" This reverts commit 4aab197ed680cc5d192c4845c009c4bd1871535e. - - - - - d13ba362 by romes at 2023-03-20T18:20:47+00:00 Revert "Revert "Revert "If filepaths have hashes then cabal can't parse them""" This reverts commit 75a2f1fd30a499d41b6eead5b8143f030653d04e. - - - - - 54dd52c2 by romes at 2023-03-20T18:22:02+00:00 Attempt to only change .conf file - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Binds.hs-boot - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/75a2f1fd30a499d41b6eead5b8143f030653d04e...54dd52c2aa97f35c429ea2688dc97fbf3665dd39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/75a2f1fd30a499d41b6eead5b8143f030653d04e...54dd52c2aa97f35c429ea2688dc97fbf3665dd39 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 18:29:44 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 20 Mar 2023 14:29:44 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] Attempt to only change .conf file Message-ID: <6418a618cc9fb_90da696f56880638@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 5694287d by romes at 2023-03-20T18:29:35+00:00 Attempt to only change .conf file - - - - - 4 changed files: - hadrian/src/Context.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/Cabal.hs Changes: ===================================== hadrian/src/Context.hs ===================================== @@ -137,7 +137,7 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath pkgConfFile context at Context {..} = do - pid <- pkgSimpleIdentifier package + pid <- pkgUnitId context dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -15,7 +15,6 @@ import Oracles.ModuleFiles import Oracles.Setting import Hadrian.Haskell.Cabal.Type (PackageData(version)) import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Hash import Hadrian.Oracles.Cabal (readPackageData) import Packages import Rules.Libffi @@ -496,7 +495,7 @@ generateConfigHs = do -- part of the WiringMap, so we don't to go back and forth between the -- unit-id and the unit-key -- we take care that they are the same by using -- 'pkgUnitId' to create the unit-id in both situations. - cProjectUnitId <- expr . pkgUnitId =<< getContext + cProjectUnitId <- expr . pkgUnitId . (\c -> c{Context.package = ghc}) =<< getContext return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeApplications #-} module Rules.Register ( configurePackageRules, registerPackageRules, registerPackages, libraryTargets @@ -20,9 +21,13 @@ import Utilities import Hadrian.Haskell.Cabal.Type import qualified Text.Parsec as Parsec import qualified Data.Set as Set +import qualified Data.Char as Char +import Data.Bifunctor(bimap) import Distribution.Version (Version) import qualified Distribution.Parsec as Cabal +import qualified Distribution.Parsec.FieldLineStream as Cabal +import qualified Distribution.Compat.CharParsing as CabalCharParsing import qualified Distribution.Types.PackageName as Cabal import qualified Distribution.Types.PackageId as Cabal @@ -183,7 +188,7 @@ buildConfFinal rs context at Context {..} _conf = do -- so that if any change ends up modifying a library (but not its .conf -- file), we still rebuild things that depend on it. dir <- (-/-) <$> libPath context <*> distDir stage - pkgid <- pkgSimpleIdentifier context + pkgid <- pkgSimpleIdentifier package files <- liftIO $ (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] @@ -252,10 +257,28 @@ getPackageNameFromConfFile conf Right (name, _) -> return name parseCabalName :: String -> Either String (String, Version) -parseCabalName = fmap f . Cabal.eitherParsec +-- Try to parse a name with a hash, but otherwise parse a name without one. +parseCabalName s = bimap show id (Cabal.runParsecParser nameWithHashParser "" $ Cabal.fieldLineStreamFromString s) + <|> fmap f (Cabal.eitherParsec s) where f :: Cabal.PackageId -> (String, Version) f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id) + -- Definition similar to 'Parsec PackageIdentifier' from Cabal but extended + -- with logic for parsing the hash (despite not returning it) + nameWithHashParser :: Cabal.ParsecParser (String, Version) + nameWithHashParser = Cabal.PP $ \_ -> do + xs' <- Parsec.sepBy component (Parsec.char '-') + case reverse xs' of + hash:version_str:xs -> + case Cabal.simpleParsec @Version version_str of + Nothing -> fail ("failed to parse a version from " <> version_str) + Just v -> + if not (null xs) && all (\c -> all (/= '.') c && not (all Char.isDigit c)) xs + then return $ (intercalate "-" (reverse xs), v) + else fail "all digits or a dot in a portion of package name" + _ -> fail "couldn't parse a hash, a version and a name" + where + component = CabalCharParsing.munch1 (\c -> Char.isAlphaNum c || c == '.') -- | Return extra library targets. extraTargets :: Context -> Action [FilePath] ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -86,7 +86,7 @@ commonCabalArgs stage = do verbosity <- expr getVerbosity ctx <- getContext pkg <- getPackage - package_id <- expr $ pkgSimpleIdentifier pkg + package_id <- expr $ pkgSimpleIdentifier pkg -- ROMES:TODO: This should really be pkgUnitId, but we can't because of recursive oracles. What do I do? let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..") mconcat [ -- Don't strip libraries when cross compiling. -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5694287de77f72c76e2e6cafbaa7c5582913a30a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5694287de77f72c76e2e6cafbaa7c5582913a30a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 19:46:25 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 20 Mar 2023 15:46:25 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/hardwire-ghc-unit-id-hadrian-hash Message-ID: <6418b81141423_90da7b81d78850a3@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/hardwire-ghc-unit-id-hadrian-hash at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/hardwire-ghc-unit-id-hadrian-hash You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 20:20:17 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Mon, 20 Mar 2023 16:20:17 -0400 Subject: [Git][ghc/ghc][wip/amg/warning-categories] 251 commits: Fixes for cabal-reinstall CI job Message-ID: <6418c001e07f6_90da88158a086997@gitlab.mail> Adam Gundry pushed to branch wip/amg/warning-categories at Glasgow Haskell Compiler / GHC Commits: 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - d9767583 by Adam Gundry at 2023-03-20T20:14:14+00:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - b9d3fdd1 by Adam Gundry at 2023-03-20T20:18:43+00:00 Move mention of warning groups change to 9.8.1 release notes - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - cabal.project-reinstall - compile_flags.txt - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Reg.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d31f9e28f07af04db477ce7ac0c805727419e2c...b9d3fdd1b6f5339b51fe0e31ece35ef75532ad1b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d31f9e28f07af04db477ce7ac0c805727419e2c...b9d3fdd1b6f5339b51fe0e31ece35ef75532ad1b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 20:54:21 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 20 Mar 2023 16:54:21 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id-hadrian-hash] IWP Message-ID: <6418c7fd62e23_90da9087f6098810@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id-hadrian-hash at Glasgow Haskell Compiler / GHC Commits: 89da2007 by romes at 2023-03-20T20:54:12+00:00 IWP - - - - - 6 changed files: - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Settings/Builders/Cabal.hs Changes: ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -113,7 +113,7 @@ parseWayUnit = Parsec.choice -- | Parse a @"pkgname-pkgversion"@ string into the package name and the -- integers that make up the package version. parsePkgId :: Parsec.Parsec String () (String, [Integer], String) -parsePkgId = parsePkgId' "" Parsec. "package identifier (-)" +parsePkgId = parseRTS <|> (parsePkgId' "" Parsec. "package identifier (--)") where parsePkgId' currName = do s <- Parsec.many1 Parsec.alphaNum @@ -122,6 +122,11 @@ parsePkgId = parsePkgId' "" Parsec. "package identifier (-)" Parsec.choice [ (,,) newName <$> parsePkgVersion <*> (Parsec.char '-' *> parsePkgHash) , parsePkgId' newName ] + parseRTS = do + _ <- Parsec.string "rts" + v <- parsePkgVersion + pure ("rts", v, "") + parsePkgHash :: Parsec.Parsec String () String parsePkgHash = Parsec.many1 Parsec.alphaNum ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -357,12 +357,12 @@ registerPackage rs context = do -- This is copied and simplified from Cabal, because we want to install the package -- into a different package database to the one it was configured against. register :: FilePath - -> FilePath + -> String -- ^ Package Identifier -> FilePath -> C.PackageDescription -> LocalBuildInfo -> IO () -register pkg_db conf_file build_dir pd lbi +register pkg_db pid build_dir pd lbi = withLibLBI pd lbi $ \lib clbi -> do absPackageDBs <- C.absolutePackageDBPaths packageDbs @@ -370,16 +370,17 @@ register pkg_db conf_file build_dir pd lbi C.silent pd lib lbi clbi False reloc build_dir (C.registrationPackageDB absPackageDBs) + liftIO $ putStrLn ("REGFILE: " <> regFile) writeRegistrationFile installedPkgInfo where - regFile = conf_file + regFile = pkg_db pid <.> "conf" reloc = relocatable lbi -- Using a specific package db here is why we have to copy the function from Cabal. packageDbs = [C.SpecificPackageDB pkg_db] writeRegistrationFile installedPkgInfo = do - writeUTF8File (pkg_db regFile <.> "conf") (CP.showInstalledPackageInfo installedPkgInfo) + writeUTF8File regFile (CP.showInstalledPackageInfo installedPkgInfo) -- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs at . ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -40,12 +40,17 @@ pkgUnitId ctx' pkg = do let ctx = ctx'{package = pkg} pid <- pkgSimpleIdentifier (package ctx) phash <- pkgHash ctx - -- Other boot packages still hardcode their unit-id to just , but we - -- can have hadrian generate a different unit-id for them just as cabal does - -- because the boot packages unit-ids are overriden by setting -this-unit-id - -- in the cabal file - liftIO $ print $ pid <> "-" <> truncateHash 4 phash - pure $ pid <> "-" <> truncateHash 4 phash + if pkgName pkg == "rts" + -- The Unit-id will change depending on the way... rTS BReaks. At some + -- point it's not even clear which way we're building + then pure pid + else do + -- Other boot packages still hardcode their unit-id to just , but we + -- can have hadrian generate a different unit-id for them just as cabal does + -- because the boot packages unit-ids are overriden by setting -this-unit-id + -- in the cabal file + liftIO $ print $ pid <> "-" <> truncateHash 4 phash + pure $ pid <> "-" <> truncateHash 4 phash where truncateHash :: Int -> String -> String ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,8 +132,8 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - -- rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts - let rtsDir = "rts" + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -54,8 +54,8 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - -- rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts - let rtsDir = "rts" + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -102,7 +102,7 @@ commonCabalArgs stage = do , arg "--cabal-file" , arg $ pkgCabalFile pkg , arg "--ipid" - , arg "$pkg-$version" + , arg package_id , arg "--prefix" , arg prefix View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89da20077c341600dc539bfbbad42856d7793d3a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89da20077c341600dc539bfbbad42856d7793d3a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 21:29:00 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 20 Mar 2023 17:29:00 -0400 Subject: [Git][ghc/ghc][wip/T23030] 74 commits: Add `Data.Functor.unzip` Message-ID: <6418d01c78503_90da99bca041007d@gitlab.mail> Ben Gamari pushed to branch wip/T23030 at Glasgow Haskell Compiler / GHC Commits: fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - 51ad1757 by Ben Gamari at 2023-03-20T17:28:54-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Shape.hs - compiler/GHC/Utils/TmpFs.hs - docs/users_guide/9.8.1-notes.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs - hadrian/doc/user-settings.md - hadrian/src/Expression.hs - hadrian/src/Flavour.hs - hadrian/src/Oracles/Flavour.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3744cff964a14e3942ff30b13eceb4dd7594deb6...51ad1757e55ad8f8ae4f902c1c609357ab16b952 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3744cff964a14e3942ff30b13eceb4dd7594deb6...51ad1757e55ad8f8ae4f902c1c609357ab16b952 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 20 23:17:39 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 20 Mar 2023 19:17:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/repr-check Message-ID: <6418e9939419a_90dab17e5d41092bc@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/repr-check at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/repr-check You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 11:52:18 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 21 Mar 2023 07:52:18 -0400 Subject: [Git][ghc/ghc][wip/T23051] 6 commits: Fix BCO creation setting caps when -j > -N Message-ID: <64199a7223e88_90da1749aa2c1686fe@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23051 at Glasgow Haskell Compiler / GHC Commits: c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - b1d17df2 by Simon Peyton Jones at 2023-03-21T11:53:52+00:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Shape.hs - docs/users_guide/9.8.1-notes.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs - m4/fp_find_cxx_std_lib.m4 - testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr - testsuite/tests/backpack/should_fail/bkpfail01.stderr - testsuite/tests/backpack/should_fail/bkpfail05.stderr - testsuite/tests/backpack/should_fail/bkpfail09.stderr - testsuite/tests/backpack/should_fail/bkpfail16.stderr - testsuite/tests/backpack/should_fail/bkpfail20.stderr - testsuite/tests/backpack/should_fail/bkpfail21.stderr - testsuite/tests/backpack/should_fail/bkpfail35.stderr - testsuite/tests/backpack/should_fail/bkpfail37.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e06ba8b1168d7346090848433aff9311fb1a2f9...b1d17df2da3483b8fee683b2994e7291156b0cc2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e06ba8b1168d7346090848433aff9311fb1a2f9...b1d17df2da3483b8fee683b2994e7291156b0cc2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 11:55:31 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 21 Mar 2023 07:55:31 -0400 Subject: [Git][ghc/ghc][wip/T23070] 3 commits: ghci: only keep the GlobalRdrEnv in ModInfo Message-ID: <64199b3385eb0_90da1724f3e4173290@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070 at Glasgow Haskell Compiler / GHC Commits: 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - f83ff87f by Simon Peyton Jones at 2023-03-21T11:57:00+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - 5 changed files: - compiler/GHC.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/Canonical.hs - + compiler/GHC/Tc/Solver/Dict.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee035eea1c4d1183f4279ac0faca0909d1faccf3...f83ff87f5b64003518d194219257267f8b177c9b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee035eea1c4d1183f4279ac0faca0909d1faccf3...f83ff87f5b64003518d194219257267f8b177c9b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 12:37:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 21 Mar 2023 08:37:11 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Rename () into Unit, (,,...,,) into Tuple (#21294) Message-ID: <6419a4f794adb_90da17bdd35c20095e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c9af5c17 by Andrei Borzenkov at 2023-03-21T08:36:49-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 4d053fea by Adam Sandberg Ericsson at 2023-03-21T08:36:49-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - c6f4b833 by Adam Sandberg Ericsson at 2023-03-21T08:36:49-04:00 docs: explain the BLOCK_MARKER event - - - - - f62c8351 by Adam Sandberg Ericsson at 2023-03-21T08:36:49-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - d8e58ab6 by Adam Sandberg Ericsson at 2023-03-21T08:36:49-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - addc667b by Adam Sandberg Ericsson at 2023-03-21T08:36:49-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - 91f94ff7 by Torsten Schmits at 2023-03-21T08:37:01-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 53b92fe1 by Bodigrim at 2023-03-21T08:37:06-04:00 Document pdep / pext primops - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types.hs-boot - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Types/Name/Cache.hs - compiler/GHC/Types/Name/Ppr.hs - docs/users_guide/eventlog-formats.rst - libraries/base/Data/Typeable/Internal.hs - libraries/ghc-prim/GHC/Tuple.hs - libraries/ghc-prim/GHC/Tuple/Prim.hs - testsuite/tests/annotations/should_fail/annfail03.stderr - testsuite/tests/annotations/should_fail/annfail04.stderr - testsuite/tests/annotations/should_fail/annfail06.stderr - testsuite/tests/annotations/should_fail/annfail09.stderr - testsuite/tests/ghc-api/T18522-dbg-ppr.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ec96ca06671b1a3fc3765616f4de067216f22c2...53b92fe1e1a2ab4839673811aad9309c078e8cef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ec96ca06671b1a3fc3765616f4de067216f22c2...53b92fe1e1a2ab4839673811aad9309c078e8cef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 13:08:52 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 21 Mar 2023 09:08:52 -0400 Subject: [Git][ghc/ghc][wip/jsem] 6 commits: Fix BCO creation setting caps when -j > -N Message-ID: <6419ac64437f_90da18ac525c221740@gitlab.mail> Matthew Pickering pushed to branch wip/jsem at Glasgow Haskell Compiler / GHC Commits: c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - 643f9a07 by sheaf at 2023-03-21T13:08:41+00:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Fixes #19349 - - - - - 30 changed files: - .gitmodules - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Shape.hs - compiler/ghc.cabal.in - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - + libraries/semaphore-compat - m4/fp_find_cxx_std_lib.m4 - packages - testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr - testsuite/tests/backpack/should_fail/bkpfail01.stderr - testsuite/tests/backpack/should_fail/bkpfail05.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b0db02e7c70ca6bfcb012e366e94a484935c775a...643f9a072fae45e74f8dc5ae10b648e868510fdd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b0db02e7c70ca6bfcb012e366e94a484935c775a...643f9a072fae45e74f8dc5ae10b648e868510fdd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 13:33:05 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 21 Mar 2023 09:33:05 -0400 Subject: [Git][ghc/ghc][wip/js-exports] Apply suggestions Message-ID: <6419b2118828d_90da190b723c230260@gitlab.mail> Josh Meredith pushed to branch wip/js-exports at Glasgow Haskell Compiler / GHC Commits: 312b7cf2 by Sylvain Henry at 2023-03-21T13:33:01+00:00 Apply suggestions - - - - - 1 changed file: - docs/users_guide/exts/ffi.rst Changes: ===================================== docs/users_guide/exts/ffi.rst ===================================== @@ -1163,12 +1163,13 @@ JSVal ^^^^^ The JavaScript backend has a concept of an untyped 'plain' JavaScript -value, under the guise of the type ``JSVal``. While many Haskell data -types are represented in JavaScript-incompatible ways under-the-hood, -``JSVal`` is represented as a real JavaScript object. +value, under the guise of the type ``JSVal``. Values having this type +are mostly opaque to Haskell codes: you can think of `JSVal` as a data type whose +data constructors aren't exposed. Its main use case is to pass opaque +JavaScript values from one FFI call to another. -The module ``GHC.JS.Prim`` from ``base`` contains functions for working -with foreign ``JSVal`` objects. Currently, it can contains the following +Nevertheless the module ``GHC.JS.Prim`` from ``base`` contains functions for +working with foreign ``JSVal`` objects. Currently, it provides the following conversions: * ``Int`` <-> ``JSVal`` (``toJSInt``, ``fromJSInt``) @@ -1201,9 +1202,9 @@ The following types are supported in this way: * ``Bool`` * ``Char`` -As in the C FFI, types in the JavaScript FFI can't be type checked, so -the following example would compile successfully - despite the type -error: +As in the C FFI, types in the JavaScript FFI can't be type checked against the foreign code, so +the following example would compile successfully - despite `5` not being a valid JavaScript value +for the Haskell `Bool` type: .. code-block:: haskell View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/312b7cf23c2c40ec3008f25c99d58ab430ae8bfa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/312b7cf23c2c40ec3008f25c99d58ab430ae8bfa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 14:06:15 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 21 Mar 2023 10:06:15 -0400 Subject: [Git][ghc/ghc][wip/js-exports] JS/FFI/Callbacks: edit user guide documentation Message-ID: <6419b9d742004_90da19c777482433e@gitlab.mail> Josh Meredith pushed to branch wip/js-exports at Glasgow Haskell Compiler / GHC Commits: 65129449 by Josh Meredith at 2023-03-21T14:06:05+00:00 JS/FFI/Callbacks: edit user guide documentation - - - - - 1 changed file: - docs/users_guide/exts/ffi.rst Changes: ===================================== docs/users_guide/exts/ffi.rst ===================================== @@ -1147,12 +1147,15 @@ FFI and the JavaScript Backend single: FFI and the JavaScript Backend GHC's JavaScript backend supports its own calling convention for -JavaScript-specific foreign imports. Instead of a function name, -the import string expected to be an unapplied JavaScript `arrow -function `_. +JavaScript-specific foreign imports. Any unapplied function is +supported, including function names. Commonly, JavaScript foreign +imports are written as an unapplied JavaScript `arrow function +`_, +but ``function`` keyword anonymous functions are also supported. -Arrow functions enable the use of arbitrary JavaScript in import -strings, so a simple example might look like: +By treating an import string as an unapplied function, arbitrary +JavaScript can be included in an import, so a simple example might +look like: .. code-block:: haskell @@ -1246,7 +1249,9 @@ must be manually released when no longer needed. On the first line of ``main``, we see where the ``Callback`` is actually created, by ``syncCallback1``. ``syncCallback`` has versions up to three, -including a zero-argument version with no suffix. +including a zero-argument version with no suffix. To use callbacks with more +than three pieces of data, it's recommended to package data into JavaScript +objects or arrays as required. There are three categories of functions that create callbacks, with the arity-1 type signatures shown here for demonstration: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65129449323bbd723a8ffbab480187de6af77c61 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65129449323bbd723a8ffbab480187de6af77c61 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 14:37:22 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 21 Mar 2023 10:37:22 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id-hadrian-hash] IWP Message-ID: <6419c12260659_90da1a7396902564cf@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id-hadrian-hash at Glasgow Haskell Compiler / GHC Commits: e38453bb by romes at 2023-03-21T14:37:07+00:00 IWP - - - - - 6 changed files: - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Settings/Builders/Cabal.hs Changes: ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -113,7 +113,7 @@ parseWayUnit = Parsec.choice -- | Parse a @"pkgname-pkgversion"@ string into the package name and the -- integers that make up the package version. parsePkgId :: Parsec.Parsec String () (String, [Integer], String) -parsePkgId = parsePkgId' "" Parsec. "package identifier (-)" +parsePkgId = parseRTS <|> (parsePkgId' "" Parsec. "package identifier (--)") where parsePkgId' currName = do s <- Parsec.many1 Parsec.alphaNum @@ -122,6 +122,11 @@ parsePkgId = parsePkgId' "" Parsec. "package identifier (-)" Parsec.choice [ (,,) newName <$> parsePkgVersion <*> (Parsec.char '-' *> parsePkgHash) , parsePkgId' newName ] + parseRTS = do + _ <- Parsec.string "rts" <* Parsec.char '-' + v <- parsePkgVersion + pure ("rts", v, "") + parsePkgHash :: Parsec.Parsec String () String parsePkgHash = Parsec.many1 Parsec.alphaNum ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -357,12 +357,12 @@ registerPackage rs context = do -- This is copied and simplified from Cabal, because we want to install the package -- into a different package database to the one it was configured against. register :: FilePath - -> FilePath + -> String -- ^ Package Identifier -> FilePath -> C.PackageDescription -> LocalBuildInfo -> IO () -register pkg_db conf_file build_dir pd lbi +register pkg_db pid build_dir pd lbi = withLibLBI pd lbi $ \lib clbi -> do absPackageDBs <- C.absolutePackageDBPaths packageDbs @@ -370,16 +370,17 @@ register pkg_db conf_file build_dir pd lbi C.silent pd lib lbi clbi False reloc build_dir (C.registrationPackageDB absPackageDBs) + liftIO $ putStrLn ("REGFILE: " <> regFile) writeRegistrationFile installedPkgInfo where - regFile = conf_file + regFile = pkg_db pid <.> "conf" reloc = relocatable lbi -- Using a specific package db here is why we have to copy the function from Cabal. packageDbs = [C.SpecificPackageDB pkg_db] writeRegistrationFile installedPkgInfo = do - writeUTF8File (pkg_db regFile <.> "conf") (CP.showInstalledPackageInfo installedPkgInfo) + writeUTF8File regFile (CP.showInstalledPackageInfo installedPkgInfo) -- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs at . ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -40,12 +40,17 @@ pkgUnitId ctx' pkg = do let ctx = ctx'{package = pkg} pid <- pkgSimpleIdentifier (package ctx) phash <- pkgHash ctx - -- Other boot packages still hardcode their unit-id to just , but we - -- can have hadrian generate a different unit-id for them just as cabal does - -- because the boot packages unit-ids are overriden by setting -this-unit-id - -- in the cabal file - liftIO $ print $ pid <> "-" <> truncateHash 4 phash - pure $ pid <> "-" <> truncateHash 4 phash + if pkgName pkg == "rts" + -- The Unit-id will change depending on the way... rTS BReaks. At some + -- point it's not even clear which way we're building + then pure pid + else do + -- Other boot packages still hardcode their unit-id to just , but we + -- can have hadrian generate a different unit-id for them just as cabal does + -- because the boot packages unit-ids are overriden by setting -this-unit-id + -- in the cabal file + liftIO $ print $ pid <> "-" <> truncateHash 4 phash + pure $ pid <> "-" <> truncateHash 4 phash where truncateHash :: Int -> String -> String ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,8 +132,8 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - -- rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts - let rtsDir = "rts" + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -54,8 +54,8 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - -- rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts - let rtsDir = "rts" + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -102,7 +102,7 @@ commonCabalArgs stage = do , arg "--cabal-file" , arg $ pkgCabalFile pkg , arg "--ipid" - , arg "$pkg-$version" + , arg package_id , arg "--prefix" , arg prefix View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e38453bbd6fe6d27ef3c6abf799d9aa12114abe8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e38453bbd6fe6d27ef3c6abf799d9aa12114abe8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 14:40:55 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 21 Mar 2023 10:40:55 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] IWP Message-ID: <6419c1f783c9d_90da1a11beac26238f@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: e38453bb by romes at 2023-03-21T14:37:07+00:00 IWP - - - - - 6 changed files: - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Settings/Builders/Cabal.hs Changes: ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -113,7 +113,7 @@ parseWayUnit = Parsec.choice -- | Parse a @"pkgname-pkgversion"@ string into the package name and the -- integers that make up the package version. parsePkgId :: Parsec.Parsec String () (String, [Integer], String) -parsePkgId = parsePkgId' "" Parsec. "package identifier (-)" +parsePkgId = parseRTS <|> (parsePkgId' "" Parsec. "package identifier (--)") where parsePkgId' currName = do s <- Parsec.many1 Parsec.alphaNum @@ -122,6 +122,11 @@ parsePkgId = parsePkgId' "" Parsec. "package identifier (-)" Parsec.choice [ (,,) newName <$> parsePkgVersion <*> (Parsec.char '-' *> parsePkgHash) , parsePkgId' newName ] + parseRTS = do + _ <- Parsec.string "rts" <* Parsec.char '-' + v <- parsePkgVersion + pure ("rts", v, "") + parsePkgHash :: Parsec.Parsec String () String parsePkgHash = Parsec.many1 Parsec.alphaNum ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -357,12 +357,12 @@ registerPackage rs context = do -- This is copied and simplified from Cabal, because we want to install the package -- into a different package database to the one it was configured against. register :: FilePath - -> FilePath + -> String -- ^ Package Identifier -> FilePath -> C.PackageDescription -> LocalBuildInfo -> IO () -register pkg_db conf_file build_dir pd lbi +register pkg_db pid build_dir pd lbi = withLibLBI pd lbi $ \lib clbi -> do absPackageDBs <- C.absolutePackageDBPaths packageDbs @@ -370,16 +370,17 @@ register pkg_db conf_file build_dir pd lbi C.silent pd lib lbi clbi False reloc build_dir (C.registrationPackageDB absPackageDBs) + liftIO $ putStrLn ("REGFILE: " <> regFile) writeRegistrationFile installedPkgInfo where - regFile = conf_file + regFile = pkg_db pid <.> "conf" reloc = relocatable lbi -- Using a specific package db here is why we have to copy the function from Cabal. packageDbs = [C.SpecificPackageDB pkg_db] writeRegistrationFile installedPkgInfo = do - writeUTF8File (pkg_db regFile <.> "conf") (CP.showInstalledPackageInfo installedPkgInfo) + writeUTF8File regFile (CP.showInstalledPackageInfo installedPkgInfo) -- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs at . ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -40,12 +40,17 @@ pkgUnitId ctx' pkg = do let ctx = ctx'{package = pkg} pid <- pkgSimpleIdentifier (package ctx) phash <- pkgHash ctx - -- Other boot packages still hardcode their unit-id to just , but we - -- can have hadrian generate a different unit-id for them just as cabal does - -- because the boot packages unit-ids are overriden by setting -this-unit-id - -- in the cabal file - liftIO $ print $ pid <> "-" <> truncateHash 4 phash - pure $ pid <> "-" <> truncateHash 4 phash + if pkgName pkg == "rts" + -- The Unit-id will change depending on the way... rTS BReaks. At some + -- point it's not even clear which way we're building + then pure pid + else do + -- Other boot packages still hardcode their unit-id to just , but we + -- can have hadrian generate a different unit-id for them just as cabal does + -- because the boot packages unit-ids are overriden by setting -this-unit-id + -- in the cabal file + liftIO $ print $ pid <> "-" <> truncateHash 4 phash + pure $ pid <> "-" <> truncateHash 4 phash where truncateHash :: Int -> String -> String ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,8 +132,8 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - -- rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts - let rtsDir = "rts" + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -54,8 +54,8 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - -- rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts - let rtsDir = "rts" + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -102,7 +102,7 @@ commonCabalArgs stage = do , arg "--cabal-file" , arg $ pkgCabalFile pkg , arg "--ipid" - , arg "$pkg-$version" + , arg package_id , arg "--prefix" , arg prefix View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e38453bbd6fe6d27ef3c6abf799d9aa12114abe8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e38453bbd6fe6d27ef3c6abf799d9aa12114abe8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 14:48:11 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 21 Mar 2023 10:48:11 -0400 Subject: [Git][ghc/ghc][wip/T23051] Be more careful about quantification Message-ID: <6419c3ab19452_90da1a819524264645@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23051 at Glasgow Haskell Compiler / GHC Commits: f0decae7 by Simon Peyton Jones at 2023-03-21T14:48:54+00:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 27 changed files: - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Validity.hs - testsuite/tests/rep-poly/RepPolyArgument.stderr - testsuite/tests/rep-poly/RepPolyDoBind.stderr - testsuite/tests/rep-poly/RepPolyDoBody1.stderr - testsuite/tests/rep-poly/RepPolyDoBody2.stderr - testsuite/tests/rep-poly/RepPolyLeftSection2.stderr - testsuite/tests/rep-poly/RepPolyMcBind.stderr - testsuite/tests/rep-poly/RepPolyMcBody.stderr - testsuite/tests/rep-poly/RepPolyMcGuard.stderr - testsuite/tests/rep-poly/RepPolyNPlusK.stderr - testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr - testsuite/tests/rep-poly/RepPolyRule1.stderr - testsuite/tests/rep-poly/RepPolyTupleSection.stderr - testsuite/tests/rep-poly/T12709.stderr - testsuite/tests/rep-poly/T12973.stderr - testsuite/tests/rep-poly/T13929.stderr - testsuite/tests/rep-poly/T19615.stderr - testsuite/tests/rep-poly/T19709b.stderr - + testsuite/tests/rep-poly/T23051.hs - + testsuite/tests/rep-poly/T23051.stderr - testsuite/tests/rep-poly/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -903,15 +903,19 @@ mkInferredPolyId residual insoluble qtvs inferred_theta poly_name mb_sig_inst mo ; let inferred_poly_ty = mkInvisForAllTys binders (mkPhiTy theta' mono_ty') ; traceTc "mkInferredPolyId" (vcat [ppr poly_name, ppr qtvs, ppr theta' - , ppr inferred_poly_ty]) + , ppr inferred_poly_ty + , text "insoluble" <+> ppr insoluble ]) + ; unless insoluble $ addErrCtxtM (mk_inf_msg poly_name inferred_poly_ty) $ do { checkEscapingKind inferred_poly_ty + -- See Note [Inferred type with escaping kind] ; checkValidType (InfSigCtxt poly_name) inferred_poly_ty } - -- See Note [Validity of inferred types] - -- If we found an insoluble error in the function definition, don't - -- do this check; otherwise (#14000) we may report an ambiguity - -- error for a rather bogus type. + -- See Note [Validity of inferred types] + -- unless insoluble: if we found an insoluble error in the + -- function definition, don't do this check; otherwise + -- (#14000) we may report an ambiguity error for a rather + -- bogus type. ; return (mkLocalId poly_name ManyTy inferred_poly_ty) } @@ -1176,6 +1180,33 @@ Examples that might fail: or multi-parameter type classes - an inferred type that includes unboxed tuples +Note [Inferred type with escaping kind] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Check for an inferred type with an escaping kind; e.g. #23051 + forall {k} {f :: k -> RuntimeRep} {g :: k} {a :: TYPE (f g)}. a +where the kind of the body of the forall mentions `f` and `g` which +are bound by the forall. No no no. + +This check, mkInferredPolyId, is really in the wrong place: +`inferred_poly_ty` doesn't obey the PKTI and it would be better not to +generalise it in the first place; see #20686. But for now it works. + +How else could we avoid generalising over escaping type variables? I +considered: + +* Adjust the generalisation in GHC.Tc.Solver to directly check for + escaping kind variables; instead, promote or default them. But that + gets into the defaulting swamp and is a non-trivial and unforced + change, so I have left it alone for now. + +* When inferring the type of a binding, in `tcMonoBinds`, we create + an ExpSigmaType with `tcInfer`. If we simply gave it an ir_frr field + that said "must have fixed runtime rep", then the kind would be made + Concrete; and we never generalise over Concrete variables. A bit + more indirect, but we need the "don't generalise over Concrete variables" + stuff anyway. + + Note [Impedance matching] ~~~~~~~~~~~~~~~~~~~~~~~~~ Consider ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2037,7 +2037,7 @@ typecheck/should_compile/tc170). Moreover in instance heads we get forall-types with kind Constraint. -It's tempting to check that the body kind is either * or #. But this is +It's tempting to check that the body kind is (TYPE _). But this is wrong. For example: class C a b @@ -2046,7 +2046,7 @@ wrong. For example: We're doing newtype-deriving for C. But notice how `a` isn't in scope in the predicate `C a`. So we quantify, yielding `forall a. C a` even though `C a` has kind `* -> Constraint`. The `forall a. C a` is a bit cheeky, but -convenient. Bottom line: don't check for * or # here. +convenient. Bottom line: don't check for (TYPE _) here. Note [Body kind of a HsQualTy] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -3547,8 +3547,12 @@ kindGeneralizeSome skol_info wanted kind_or_type -- here will already have all type variables quantified; -- thus, every free variable is really a kv, never a tv. ; dvs <- candidateQTyVarsOfKind kind_or_type - ; dvs <- filterConstrainedCandidates wanted dvs - ; quantifyTyVars skol_info DefaultNonStandardTyVars dvs } + ; filtered_dvs <- filterConstrainedCandidates wanted dvs + ; traceTc "kindGeneralizeSome" $ + vcat [ text "type:" <+> ppr kind_or_type + , text "dvs:" <+> ppr dvs + , text "filtered_dvs:" <+> ppr filtered_dvs ] + ; quantifyTyVars skol_info DefaultNonStandardTyVars filtered_dvs } filterConstrainedCandidates :: WantedConstraints -- Don't quantify over variables free in these ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1279,10 +1279,6 @@ emitResidualConstraints rhs_tclvl ev_binds_var -- uniformly. -------------------- -ctsPreds :: Cts -> [PredType] -ctsPreds cts = [ ctEvPred ev | ct <- bagToList cts - , let ev = ctEvidence ct ] - findInferredDiff :: TcThetaType -> TcThetaType -> TcM TcThetaType -- Given a partial type signature f :: (C a, D a, _) => blah -- and the inferred constraints (X a, D a, Y a, C a) @@ -1397,7 +1393,7 @@ Note [Deciding quantification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If the monomorphism restriction does not apply, then we quantify as follows: -* Step 1: decideMonoTyVars. +* Step 1: decidePromotedTyVars. Take the global tyvars, and "grow" them using functional dependencies E.g. if x:alpha is in the environment, and alpha ~ [beta] (which can happen because alpha is untouchable here) then do not quantify over @@ -1408,10 +1404,11 @@ If the monomorphism restriction does not apply, then we quantify as follows: We also account for the monomorphism restriction; if it applies, add the free vars of all the constraints. - Result is mono_tvs; we will not quantify over these. + Result is mono_tvs; we will promote all of these to the outer levek, + and certainly not quantify over them. * Step 2: defaultTyVarsAndSimplify. - Default any non-mono tyvars (i.e ones that are definitely + Default any non-promoted tyvars (i.e ones that are definitely not going to become further constrained), and re-simplify the candidate constraints. @@ -1431,7 +1428,7 @@ If the monomorphism restriction does not apply, then we quantify as follows: over are determined in Step 3 (not in Step 1), it is OK for the mono_tvs to be missing some variables free in the environment. This is why removing the psig_qtvs is OK in - decideMonoTyVars. Test case for this scenario: T14479. + decidePromotedTyVars. Test case for this scenario: T14479. * Step 3: decideQuantifiedTyVars. Decide which variables to quantify over, as follows: @@ -1559,7 +1556,7 @@ and we are running simplifyInfer over These are two implication constraints, both of which contain a wanted for the class C. Neither constraint mentions the bound -skolem. We might imagine that these constraint could thus float +skolem. We might imagine that these constraints could thus float out of their implications and then interact, causing beta1 to unify with beta2, but constraints do not currently float out of implications. @@ -1609,12 +1606,12 @@ decideQuantification -- See Note [Deciding quantification] decideQuantification skol_info infer_mode rhs_tclvl name_taus psigs candidates = do { -- Step 1: find the mono_tvs - ; (mono_tvs, candidates, co_vars) <- decideMonoTyVars infer_mode - name_taus psigs candidates + ; (candidates, co_vars) <- decidePromotedTyVars infer_mode + name_taus psigs candidates -- Step 2: default any non-mono tyvars, and re-simplify -- This step may do some unification, but result candidates is zonked - ; candidates <- defaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates + ; candidates <- defaultTyVarsAndSimplify rhs_tclvl candidates -- Step 3: decide which kind/type variables to quantify over ; qtvs <- decideQuantifiedTyVars skol_info name_taus psigs candidates @@ -1647,7 +1644,6 @@ decideQuantification skol_info infer_mode rhs_tclvl name_taus psigs candidates (vcat [ text "infer_mode:" <+> ppr infer_mode , text "candidates:" <+> ppr candidates , text "psig_theta:" <+> ppr psig_theta - , text "mono_tvs:" <+> ppr mono_tvs , text "co_vars:" <+> ppr co_vars , text "qtvs:" <+> ppr qtvs , text "theta:" <+> ppr theta ]) @@ -1686,23 +1682,34 @@ ambiguous types. Something like But that's a battle for another day. -} -decideMonoTyVars :: InferMode - -> [(Name,TcType)] - -> [TcIdSigInst] - -> [PredType] - -> TcM (TcTyCoVarSet, [PredType], CoVarSet) --- Decide which tyvars and covars cannot be generalised: --- (a) Free in the environment --- (b) Mentioned in a constraint we can't generalise --- (c) Connected by an equality or fundep to (a) or (b) +decidePromotedTyVars :: InferMode + -> [(Name,TcType)] + -> [TcIdSigInst] + -> [PredType] + -> TcM ([PredType], CoVarSet) +-- We are about to generalise over type variables at level N +-- Each must be either +-- (P) promoted +-- (D) defaulted +-- (Q) quantified +-- This function finds (P), the type variables that we are going to promote: +-- (a) Mentioned in a constraint we can't generalise (the MR) +-- (b) Mentioned in the kind of a CoVar; we can't quantify over a CoVar, +-- so we must not quantify over a type variable free in its kind +-- (c) Connected by an equality or fundep to +-- * a type variable at level < N, or +-- * A tyvar subject to (a), (b) or (c) +-- Having found all such level-N tyvars that we can't generalise, +-- promote them, to eliminate them from further consideration. +-- -- Also return CoVars that appear free in the final quantified types -- we can't quantify over these, and we must make sure they are in scope -decideMonoTyVars infer_mode name_taus psigs candidates +decidePromotedTyVars infer_mode name_taus psigs candidates = do { (no_quant, maybe_quant) <- pick infer_mode candidates -- If possible, we quantify over partial-sig qtvs, so they are -- not mono. Need to zonk them because they are meta-tyvar TyVarTvs - ; psig_qtvs <- zonkTcTyVarsToTcTyVars $ binderVars $ + ; psig_qtvs <- zonkTcTyVarsToTcTyVars $ binderVars $ concatMap (map snd . sig_inst_skols) psigs ; psig_theta <- mapM TcM.zonkTcType $ @@ -1713,29 +1720,31 @@ decideMonoTyVars infer_mode name_taus psigs candidates ; tc_lvl <- TcM.getTcLevel ; let psig_tys = mkTyVarTys psig_qtvs ++ psig_theta + -- (b) The co_var_tvs are tvs mentioned in the types of covars or + -- coercion holes. We can't quantify over these covars, so we + -- must include the variable in their types in the mono_tvs. + -- E.g. If we can't quantify over co :: k~Type, then we can't + -- quantify over k either! Hence closeOverKinds + -- Recall that coVarsOfTypes also returns coercion holes co_vars = coVarsOfTypes (psig_tys ++ taus ++ candidates) co_var_tvs = closeOverKinds co_vars - -- The co_var_tvs are tvs mentioned in the types of covars or - -- coercion holes. We can't quantify over these covars, so we - -- must include the variable in their types in the mono_tvs. - -- E.g. If we can't quantify over co :: k~Type, then we can't - -- quantify over k either! Hence closeOverKinds mono_tvs0 = filterVarSet (not . isQuantifiableTv tc_lvl) $ tyCoVarsOfTypes candidates -- We need to grab all the non-quantifiable tyvars in the -- types so that we can grow this set to find other - -- non-quantifiable tyvars. This can happen with something - -- like + -- non-quantifiable tyvars. This can happen with something like -- f x y = ... -- where z = x 3 -- The body of z tries to unify the type of x (call it alpha[1]) -- with (beta[2] -> gamma[2]). This unification fails because - -- alpha is untouchable. But we need to know not to quantify over - -- beta or gamma, because they are in the equality constraint with - -- alpha. Actual test case: typecheck/should_compile/tc213 + -- alpha is untouchable, leaving [W] alpha[1] ~ (beta[2] -> gamma[2]). + -- We need to know not to quantify over beta or gamma, because they + -- are in the equality constraint with alpha. Actual test case: + -- typecheck/should_compile/tc213 mono_tvs1 = mono_tvs0 `unionVarSet` co_var_tvs + -- mono_tvs1 is now the set of variables from an outer scope -- (that's mono_tvs0) and the set of covars, closed over kinds. -- Given this set of variables we know we will not quantify, @@ -1749,9 +1758,8 @@ decideMonoTyVars infer_mode name_taus psigs candidates -- (that is, we might have IP "c" Bool and IP "c" Int in different -- places within the same program), and -- skipping this causes implicit params to monomorphise too many - -- variables; see Note [Inheriting implicit parameters] in - -- GHC.Tc.Solver. Skipping causes typecheck/should_compile/tc219 - -- to fail. + -- variables; see Note [Inheriting implicit parameters] in GHC.Tc.Solver. + -- Skipping causes typecheck/should_compile/tc219 to fail. mono_tvs2 = closeWrtFunDeps non_ip_candidates mono_tvs1 -- mono_tvs2 now contains any variable determined by the "root @@ -1761,7 +1769,7 @@ decideMonoTyVars infer_mode name_taus psigs candidates closeWrtFunDeps non_ip_candidates (tyCoVarsOfTypes no_quant) `minusVarSet` mono_tvs2 -- constrained_tvs: the tyvars that we are not going to - -- quantify solely because of the monomorphism restriction + -- quantify /solely/ because of the monomorphism restriction -- -- (`minusVarSet` mono_tvs2): a type variable is only -- "constrained" (so that the MR bites) if it is not @@ -1783,7 +1791,12 @@ decideMonoTyVars infer_mode name_taus psigs candidates let dia = TcRnMonomorphicBindings (map fst name_taus) diagnosticTc (constrained_tvs `intersectsVarSet` tyCoVarsOfTypes taus) dia - ; traceTc "decideMonoTyVars" $ vcat + -- Promote the mono_tvs + -- See Note [Promote monomorphic tyvars] + ; traceTc "decidePromotedTyVars: promotion:" (ppr mono_tvs) + ; _ <- promoteTyVarSet mono_tvs + + ; traceTc "decidePromotedTyVars" $ vcat [ text "infer_mode =" <+> ppr infer_mode , text "mono_tvs0 =" <+> ppr mono_tvs0 , text "no_quant =" <+> ppr no_quant @@ -1791,7 +1804,7 @@ decideMonoTyVars infer_mode name_taus psigs candidates , text "mono_tvs =" <+> ppr mono_tvs , text "co_vars =" <+> ppr co_vars ] - ; return (mono_tvs, maybe_quant, co_vars) } + ; return (maybe_quant, co_vars) } where pick :: InferMode -> [PredType] -> TcM ([PredType], [PredType]) -- Split the candidates into ones we definitely @@ -1811,48 +1824,34 @@ decideMonoTyVars infer_mode name_taus psigs candidates ------------------- defaultTyVarsAndSimplify :: TcLevel - -> TyCoVarSet -- Promote these mono-tyvars -> [PredType] -- Assumed zonked -> TcM [PredType] -- Guaranteed zonked --- Promote the known-monomorphic tyvars; -- Default any tyvar free in the constraints; -- and re-simplify in case the defaulting allows further simplification -defaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates - = do { -- Promote any tyvars that we cannot generalise - -- See Note [Promote monomorphic tyvars] - ; traceTc "decideMonoTyVars: promotion:" (ppr mono_tvs) - ; _ <- promoteTyVarSet mono_tvs - - -- Default any kind/levity vars +defaultTyVarsAndSimplify rhs_tclvl candidates + = do { -- Default any kind/levity vars ; DV {dv_kvs = cand_kvs, dv_tvs = cand_tvs} <- candidateQTyVarsOfTypes candidates - -- any covars should already be handled by - -- the logic in decideMonoTyVars, which looks at - -- the constraints generated + -- NB1: decidePromotedTyVars has promoted any type variable fixed by the + -- type envt, so they won't be chosen by candidateQTyVarsOfTypes + -- NB2: Defaulting for variables free in tau_tys is done later, by quantifyTyVars + -- Hence looking only at 'candidates' + -- NB3: Any covars should already be handled by + -- the logic in decidePromotedTyVars, which looks at + -- the constraints generated ; poly_kinds <- xoptM LangExt.PolyKinds - ; mapM_ (default_one poly_kinds True) (dVarSetElems cand_kvs) - ; mapM_ (default_one poly_kinds False) (dVarSetElems (cand_tvs `minusDVarSet` cand_kvs)) + ; let default_kv | poly_kinds = default_tv + | otherwise = defaultTyVar DefaultKindVars + default_tv = defaultTyVar (NonStandardDefaulting DefaultNonStandardTyVars) + ; mapM_ default_kv (dVarSetElems cand_kvs) + ; mapM_ default_tv (dVarSetElems (cand_tvs `minusDVarSet` cand_kvs)) ; simplify_cand candidates } where - default_one poly_kinds is_kind_var tv - | not (isMetaTyVar tv) - = return () - | tv `elemVarSet` mono_tvs - = return () - | otherwise - = void $ defaultTyVar - (if not poly_kinds && is_kind_var - then DefaultKindVars - else NonStandardDefaulting DefaultNonStandardTyVars) - -- NB: only pass 'DefaultKindVars' when we know we're dealing with a kind variable. - tv - - -- this common case (no inferred constraints) should be fast - simplify_cand [] = return [] - -- see Note [Unconditionally resimplify constraints when quantifying] + -- See Note [Unconditionally resimplify constraints when quantifying] + simplify_cand [] = return [] -- Fast path simplify_cand candidates = do { clone_wanteds <- newWanteds DefaultOrigin candidates ; WC { wc_simple = simples } <- setTcLevel rhs_tclvl $ @@ -2086,7 +2085,7 @@ sure to quantify over them. This leads to several wrinkles: In the signature for 'g', we cannot quantify over 'b' because it turns out to get unified with 'a', which is free in g's environment. So we carefully - refrain from bogusly quantifying, in GHC.Tc.Solver.decideMonoTyVars. We + refrain from bogusly quantifying, in GHC.Tc.Solver.decidePromotedTyVars. We report the error later, in GHC.Tc.Gen.Bind.chooseInferredQuantifiers. Note [growThetaTyVars vs closeWrtFunDeps] @@ -2122,7 +2121,7 @@ constraint (transitively). We use closeWrtFunDeps in places where we need to know which variables are *always* determined by some seed set. This includes - * when determining the mono-tyvars in decideMonoTyVars. If `a` + * when determining the mono-tyvars in decidePromotedTyVars. If `a` is going to be monomorphic, we need b and c to be also: they are determined by the choice for `a`. * when checking instance coverage, in ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Tc.Types.Constraint ( assertFuelPrecondition, assertFuelPreconditionStrict, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, - isEmptyCts, + isEmptyCts, ctsPreds, isPendingScDict, pendingScDict_maybe, superClassesMightHelp, getPendingWantedScs, isWantedCt, isGivenCt, @@ -1043,6 +1043,9 @@ emptyCts = emptyBag isEmptyCts :: Cts -> Bool isEmptyCts = isEmptyBag +ctsPreds :: Cts -> [PredType] +ctsPreds cts = foldr ((:) . ctPred) [] cts + pprCts :: Cts -> SDoc pprCts cts = vcat (map ppr (bagToList cts)) ===================================== compiler/GHC/Tc/Utils/Concrete.hs ===================================== @@ -37,8 +37,12 @@ import GHC.Tc.Utils.TcMType ( newConcreteTyVar, isFilledMetaTyVar_maybe, writ , emitWantedEq ) import GHC.Types.Basic ( TypeOrKind(..) ) +import GHC.Types.Name ( getOccName ) +import GHC.Types.Name.Occurrence( occNameFS ) import GHC.Utils.Misc ( HasDebugCallStack ) import GHC.Utils.Outputable +import GHC.Data.FastString ( fsLit ) + import Control.Monad ( void ) import Data.Functor ( ($>) ) @@ -495,7 +499,7 @@ unifyConcrete frr_orig ty -- Create a new ConcreteTv metavariable @concrete_tv@ -- and unify @ty ~# concrete_tv at . ; _ -> - do { conc_tv <- newConcreteTyVar (ConcreteFRR frr_orig) ki + do { conc_tv <- newConcreteTyVar (ConcreteFRR frr_orig) (fsLit "cx") ki -- NB: newConcreteTyVar asserts that 'ki' is concrete. ; coToMCo <$> emitWantedEq orig KindLevel Nominal ty (mkTyVarTy conc_tv) } } } where @@ -647,9 +651,12 @@ makeTypeConcrete conc_orig ty = , TauTv <- metaTyVarInfo tv -> -- Change the MetaInfo to ConcreteTv, but retain the TcLevel do { kind <- go (tyVarKind tv) + ; let occ_fs = occNameFS (getOccName tv) + -- occ_fs: preserve the occurrence name of the original tyvar + -- This helps in error messages ; lift $ do { conc_tv <- setTcLevel (tcTyVarLevel tv) $ - newConcreteTyVar conc_orig kind + newConcreteTyVar conc_orig occ_fs kind ; let conc_ty = mkTyVarTy conc_tv ; writeMetaTyVar tv conc_ty ; return conc_ty } } ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -45,8 +45,6 @@ module GHC.Tc.Utils.TcMType ( unpackCoercionHole, unpackCoercionHole_maybe, checkCoercionHole, - ConcreteHole, newConcreteHole, - newImplication, -------------------------------- @@ -414,23 +412,6 @@ checkCoercionHole cv co | otherwise = False --- | A coercion hole used to store evidence for `Concrete#` constraints. --- --- See Note [The Concrete mechanism]. -type ConcreteHole = CoercionHole - --- | Create a new (initially unfilled) coercion hole, --- to hold evidence for a @'Concrete#' (ty :: ki)@ constraint. -newConcreteHole :: Kind -- ^ Kind of the thing we want to ensure is concrete (e.g. 'runtimeRepTy') - -> Type -- ^ Thing we want to ensure is concrete (e.g. some 'RuntimeRep') - -> TcM (ConcreteHole, TcType) - -- ^ where to put the evidence, and a metavariable to store - -- the concrete type -newConcreteHole ki ty - = do { concrete_ty <- newFlexiTyVarTy ki - ; let co_ty = mkHeteroPrimEqPred ki ki ty concrete_ty - ; hole <- newCoercionHole co_ty - ; return (hole, concrete_ty) } {- ********************************************************************** * @@ -840,11 +821,13 @@ cloneTyVarTyVar name kind -- -- Invariant: the kind must be concrete, as per Note [ConcreteTv]. -- This is checked with an assertion. -newConcreteTyVar :: HasDebugCallStack => ConcreteTvOrigin -> TcKind -> TcM TcTyVar -newConcreteTyVar reason kind = - assertPpr (isConcrete kind) - (text "newConcreteTyVar: non-concrete kind" <+> ppr kind) - $ newAnonMetaTyVar (ConcreteTv reason) kind +newConcreteTyVar :: HasDebugCallStack => ConcreteTvOrigin + -> FastString -> TcKind -> TcM TcTyVar +newConcreteTyVar reason fs kind + = assertPpr (isConcrete kind) assert_msg $ + newNamedAnonMetaTyVar fs (ConcreteTv reason) kind + where + assert_msg = text "newConcreteTyVar: non-concrete kind" <+> ppr kind newPatSigTyVar :: Name -> Kind -> TcM TcTyVar newPatSigTyVar name kind @@ -1242,14 +1225,14 @@ NB: this is all rather similar to, but sadly not the same as Wrinkle: -We must make absolutely sure that alpha indeed is not -from an outer context. (Otherwise, we might indeed learn more information -about it.) This can be done easily: we just check alpha's TcLevel. -That level must be strictly greater than the ambient TcLevel in order -to treat it as naughty. We say "strictly greater than" because the call to +We must make absolutely sure that alpha indeed is not from an outer +context. (Otherwise, we might indeed learn more information about it.) +This can be done easily: we just check alpha's TcLevel. That level +must be strictly greater than the ambient TcLevel in order to treat it +as naughty. We say "strictly greater than" because the call to candidateQTyVars is made outside the bumped TcLevel, as stated in the -comment to candidateQTyVarsOfType. The level check is done in go_tv -in collect_cand_qtvs. Skipping this check caused #16517. +comment to candidateQTyVarsOfType. The level check is done in go_tv in +collect_cand_qtvs. Skipping this check caused #16517. -} @@ -1349,8 +1332,9 @@ candidateQTyVarsWithBinders :: [TyVar] -> Type -> TcM CandidatesQTvs -- Because we are going to scoped-sort the quantified variables -- in among the tvs candidateQTyVarsWithBinders bound_tvs ty - = do { kvs <- candidateQTyVarsOfKinds (map tyVarKind bound_tvs) - ; all_tvs <- collect_cand_qtvs ty False emptyVarSet kvs ty + = do { kvs <- candidateQTyVarsOfKinds (map tyVarKind bound_tvs) + ; cur_lvl <- getTcLevel + ; all_tvs <- collect_cand_qtvs ty False cur_lvl emptyVarSet kvs ty ; return (all_tvs `delCandidates` bound_tvs) } -- | Gathers free variables to use as quantification candidates (in @@ -1362,14 +1346,18 @@ candidateQTyVarsWithBinders bound_tvs ty -- See Note [Dependent type variables] candidateQTyVarsOfType :: TcType -- not necessarily zonked -> TcM CandidatesQTvs -candidateQTyVarsOfType ty = collect_cand_qtvs ty False emptyVarSet mempty ty +candidateQTyVarsOfType ty + = do { cur_lvl <- getTcLevel + ; collect_cand_qtvs ty False cur_lvl emptyVarSet mempty ty } -- | Like 'candidateQTyVarsOfType', but over a list of types -- The variables to quantify must have a TcLevel strictly greater than -- the ambient level. (See Wrinkle in Note [Naughty quantification candidates]) candidateQTyVarsOfTypes :: [Type] -> TcM CandidatesQTvs -candidateQTyVarsOfTypes tys = foldlM (\acc ty -> collect_cand_qtvs ty False emptyVarSet acc ty) - mempty tys +candidateQTyVarsOfTypes tys + = do { cur_lvl <- getTcLevel + ; foldlM (\acc ty -> collect_cand_qtvs ty False cur_lvl emptyVarSet acc ty) + mempty tys } -- | Like 'candidateQTyVarsOfType', but consider every free variable -- to be dependent. This is appropriate when generalizing a *kind*, @@ -1377,16 +1365,21 @@ candidateQTyVarsOfTypes tys = foldlM (\acc ty -> collect_cand_qtvs ty False empt -- to Type.) candidateQTyVarsOfKind :: TcKind -- Not necessarily zonked -> TcM CandidatesQTvs -candidateQTyVarsOfKind ty = collect_cand_qtvs ty True emptyVarSet mempty ty +candidateQTyVarsOfKind ty + = do { cur_lvl <- getTcLevel + ; collect_cand_qtvs ty True cur_lvl emptyVarSet mempty ty } candidateQTyVarsOfKinds :: [TcKind] -- Not necessarily zonked -> TcM CandidatesQTvs -candidateQTyVarsOfKinds tys = foldM (\acc ty -> collect_cand_qtvs ty True emptyVarSet acc ty) - mempty tys +candidateQTyVarsOfKinds tys + = do { cur_lvl <- getTcLevel + ; foldM (\acc ty -> collect_cand_qtvs ty True cur_lvl emptyVarSet acc ty) + mempty tys } collect_cand_qtvs - :: TcType -- original type that we started recurring into; for errors + :: TcType -- Original type that we started recurring into; for errors -> Bool -- True <=> consider every fv in Type to be dependent + -> TcLevel -- Current TcLevel; collect only tyvars whose level is greater -> VarSet -- Bound variables (locals only) -> CandidatesQTvs -- Accumulating parameter -> Type -- Not necessarily zonked @@ -1403,7 +1396,7 @@ collect_cand_qtvs -- so that subsequent dependency analysis (to build a well -- scoped telescope) works correctly -collect_cand_qtvs orig_ty is_dep bound dvs ty +collect_cand_qtvs orig_ty is_dep cur_lvl bound dvs ty = go dvs ty where is_bound tv = tv `elemVarSet` bound @@ -1411,13 +1404,13 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty ----------------- go :: CandidatesQTvs -> TcType -> TcM CandidatesQTvs -- Uses accumulating-parameter style - go dv (AppTy t1 t2) = foldlM go dv [t1, t2] - go dv (TyConApp tc tys) = go_tc_args dv (tyConBinders tc) tys + go dv (AppTy t1 t2) = foldlM go dv [t1, t2] + go dv (TyConApp tc tys) = go_tc_args dv (tyConBinders tc) tys go dv (FunTy _ w arg res) = foldlM go dv [w, arg, res] - go dv (LitTy {}) = return dv - go dv (CastTy ty co) = do dv1 <- go dv ty - collect_cand_qtvs_co orig_ty bound dv1 co - go dv (CoercionTy co) = collect_cand_qtvs_co orig_ty bound dv co + go dv (LitTy {}) = return dv + go dv (CastTy ty co) = do { dv1 <- go dv ty + ; collect_cand_qtvs_co orig_ty cur_lvl bound dv1 co } + go dv (CoercionTy co) = collect_cand_qtvs_co orig_ty cur_lvl bound dv co go dv (TyVarTy tv) | is_bound tv = return dv @@ -1427,8 +1420,8 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty Nothing -> go_tv dv tv } go dv (ForAllTy (Bndr tv _) ty) - = do { dv1 <- collect_cand_qtvs orig_ty True bound dv (tyVarKind tv) - ; collect_cand_qtvs orig_ty is_dep (bound `extendVarSet` tv) dv1 ty } + = do { dv1 <- collect_cand_qtvs orig_ty True cur_lvl bound dv (tyVarKind tv) + ; collect_cand_qtvs orig_ty is_dep cur_lvl (bound `extendVarSet` tv) dv1 ty } -- This makes sure that we default e.g. the alpha in Proxy alpha (Any alpha). -- Tested in polykinds/NestedProxies. @@ -1437,7 +1430,7 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty -- to look at kinds. go_tc_args dv (tc_bndr:tc_bndrs) (ty:tys) = do { dv1 <- collect_cand_qtvs orig_ty (is_dep || isNamedTyConBinder tc_bndr) - bound dv ty + cur_lvl bound dv ty ; go_tc_args dv1 tc_bndrs tys } go_tc_args dv _bndrs tys -- _bndrs might be non-empty: undersaturation -- tys might be non-empty: oversaturation @@ -1446,6 +1439,21 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty ----------------- go_tv dv@(DV { dv_kvs = kvs, dv_tvs = tvs }) tv + | tcTyVarLevel tv <= cur_lvl + = return dv -- This variable is from an outer context; skip + -- See Note [Use level numbers for quantification] + + | case tcTyVarDetails tv of + SkolemTv _ lvl _ -> lvl > pushTcLevel cur_lvl + _ -> False + = return dv -- Skip inner skolems + -- This only happens for erroneous program with bad telescopes + -- e.g. BadTelescope2: forall a k (b :: k). SameKind a b + -- We have (a::k), and at the outer we don't want to quantify + -- over the already-quantified skolem k. + -- (Apparently we /do/ want to quantify over skolems whose level sk_lvl is + -- sk_lvl > cur_lvl; you get lots of failures otherwise. A battle for another day.) + | tv `elemDVarSet` kvs = return dv -- We have met this tyvar already @@ -1461,17 +1469,7 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty -- (which comes next) works correctly ; let tv_kind_vars = tyCoVarsOfType tv_kind - ; cur_lvl <- getTcLevel - ; if | tcTyVarLevel tv <= cur_lvl - -> return dv -- this variable is from an outer context; skip - -- See Note [Use level numbers for quantification] - - | case tcTyVarDetails tv of - SkolemTv _ lvl _ -> lvl > pushTcLevel cur_lvl - _ -> False - -> return dv -- Skip inner skolems; ToDo: explain - - | intersectsVarSet bound tv_kind_vars + ; if | intersectsVarSet bound tv_kind_vars -- the tyvar must not be from an outer context, but we have -- already checked for this. -- See Note [Naughty quantification candidates] @@ -1490,25 +1488,26 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty -- See Note [Order of accumulation] -- See Note [Recurring into kinds for candidateQTyVars] - ; collect_cand_qtvs orig_ty True bound dv' tv_kind } } + ; collect_cand_qtvs orig_ty True cur_lvl bound dv' tv_kind } } collect_cand_qtvs_co :: TcType -- original type at top of recursion; for errors + -> TcLevel -> VarSet -- bound variables -> CandidatesQTvs -> Coercion -> TcM CandidatesQTvs -collect_cand_qtvs_co orig_ty bound = go_co +collect_cand_qtvs_co orig_ty cur_lvl bound = go_co where - go_co dv (Refl ty) = collect_cand_qtvs orig_ty True bound dv ty - go_co dv (GRefl _ ty mco) = do dv1 <- collect_cand_qtvs orig_ty True bound dv ty - go_mco dv1 mco + go_co dv (Refl ty) = collect_cand_qtvs orig_ty True cur_lvl bound dv ty + go_co dv (GRefl _ ty mco) = do { dv1 <- collect_cand_qtvs orig_ty True cur_lvl bound dv ty + ; go_mco dv1 mco } go_co dv (TyConAppCo _ _ cos) = foldlM go_co dv cos go_co dv (AppCo co1 co2) = foldlM go_co dv [co1, co2] go_co dv (FunCo _ _ _ w co1 co2) = foldlM go_co dv [w, co1, co2] go_co dv (AxiomInstCo _ _ cos) = foldlM go_co dv cos go_co dv (AxiomRuleCo _ cos) = foldlM go_co dv cos - go_co dv (UnivCo prov _ t1 t2) = do dv1 <- go_prov dv prov - dv2 <- collect_cand_qtvs orig_ty True bound dv1 t1 - collect_cand_qtvs orig_ty True bound dv2 t2 + go_co dv (UnivCo prov _ t1 t2) = do { dv1 <- go_prov dv prov + ; dv2 <- collect_cand_qtvs orig_ty True cur_lvl bound dv1 t1 + ; collect_cand_qtvs orig_ty True cur_lvl bound dv2 t2 } go_co dv (SymCo co) = go_co dv co go_co dv (TransCo co1 co2) = foldlM go_co dv [co1, co2] go_co dv (SelCo _ co) = go_co dv co @@ -1527,7 +1526,7 @@ collect_cand_qtvs_co orig_ty bound = go_co go_co dv (ForAllCo tcv kind_co co) = do { dv1 <- go_co dv kind_co - ; collect_cand_qtvs_co orig_ty (bound `extendVarSet` tcv) dv1 co } + ; collect_cand_qtvs_co orig_ty cur_lvl (bound `extendVarSet` tcv) dv1 co } go_mco dv MRefl = return dv go_mco dv (MCo co) = go_co dv co @@ -1543,7 +1542,7 @@ collect_cand_qtvs_co orig_ty bound = go_co | cv `elemVarSet` cvs = return dv -- See Note [Recurring into kinds for candidateQTyVars] - | otherwise = collect_cand_qtvs orig_ty True bound + | otherwise = collect_cand_qtvs orig_ty True cur_lvl bound (dv { dv_cvs = cvs `extendVarSet` cv }) (idType cv) @@ -1810,17 +1809,30 @@ defaultTyVar def_strat tv = do { traceTc "Defaulting a RuntimeRep var to LiftedRep" (ppr tv) ; writeMetaTyVar tv liftedRepTy ; return True } + | isLevityVar tv , default_ns_vars = do { traceTc "Defaulting a Levity var to Lifted" (ppr tv) ; writeMetaTyVar tv liftedDataConTy ; return True } + | isMultiplicityVar tv , default_ns_vars = do { traceTc "Defaulting a Multiplicity var to Many" (ppr tv) ; writeMetaTyVar tv manyDataConTy ; return True } + | isConcreteTyVar tv + -- We don't want to quantify; but neither can we default to + -- anything sensible. (If it has kind RuntimeRep or Levity, as is + -- often the case, it'll have been caught earlier by earlier + -- cases. So in this exotic situation we just promote. Not very + -- satisfing, but it's very much a corner case: #23051 + -- We should really implement the plan in #20686. + = do { lvl <- getTcLevel + ; _ <- promoteMetaTyVarTo lvl tv + ; return True } + | DefaultKindVars <- def_strat -- -XNoPolyKinds and this is a kind var: we must default it = default_kind_var tv @@ -1872,9 +1884,8 @@ defaultTyVars ns_strat dvs ; let def_tvs, def_kvs :: DefaultingStrategy def_tvs = NonStandardDefaulting ns_strat - def_kvs - | poly_kinds = def_tvs - | otherwise = DefaultKindVars + def_kvs | poly_kinds = def_tvs + | otherwise = DefaultKindVars -- As -XNoPolyKinds precludes polymorphic kind variables, we default them. -- For example: -- @@ -1965,7 +1976,7 @@ What do do? D. We could error. We choose (D), as described in #17567, and implement this choice in -doNotQuantifyTyVars. Discussion of alternativs A-C is below. +doNotQuantifyTyVars. Discussion of alternatives A-C is below. NB: this is all rather similar to, but sadly not the same as Note [Naughty quantification candidates] ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -475,7 +475,7 @@ This is not OK: we get MkT :: forall l. T @l :: TYPE (BoxedRep l) which is ill-kinded. -For ordinary /user-written type signatures f :: blah, we make this +For ordinary /user-written/ type signatures f :: blah, we make this check as part of kind-checking the type signature in tcHsSigType; see Note [Escaping kind in type signatures] in GHC.Tc.Gen.HsType. ===================================== testsuite/tests/rep-poly/RepPolyArgument.stderr ===================================== @@ -3,8 +3,8 @@ RepPolyArgument.hs:10:18: error: [GHC-55287] • The argument ‘(undefined @(R @RuntimeRep))’ of ‘undefined’ does not have a fixed runtime representation. Its type is: - t0 :: TYPE c0 - Cannot unify ‘R’ with the type variable ‘c0’ + t1 :: TYPE t0 + Cannot unify ‘R’ with the type variable ‘t0’ because it is not a concrete ‘RuntimeRep’. • In the first argument of ‘undefined’, namely ‘(undefined @(R @RuntimeRep))’ ===================================== testsuite/tests/rep-poly/RepPolyDoBind.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyDoBind.hs:26:3: error: [GHC-55287] arising from a do statement does not have a fixed runtime representation. Its type is: - ma0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + ma0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a 'do' block: a <- undefined In the expression: ===================================== testsuite/tests/rep-poly/RepPolyDoBody1.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyDoBody1.hs:24:3: error: [GHC-55287] arising from a do statement does not have a fixed runtime representation. Its type is: - ma0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + ma0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a 'do' block: undefined :: ma In the expression: ===================================== testsuite/tests/rep-poly/RepPolyDoBody2.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyDoBody2.hs:23:3: error: [GHC-55287] arising from a do statement does not have a fixed runtime representation. Its type is: - mb0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + mb0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a 'do' block: undefined :: () In the expression: ===================================== testsuite/tests/rep-poly/RepPolyLeftSection2.stderr ===================================== @@ -3,8 +3,8 @@ RepPolyLeftSection2.hs:14:11: error: [GHC-55287] • The argument ‘undefined’ of ‘f’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ + a0 :: TYPE r0 + Cannot unify ‘r’ with the type variable ‘r0’ because it is not a concrete ‘RuntimeRep’. • In the expression: undefined `f` In an equation for ‘test1’: test1 = (undefined `f`) ===================================== testsuite/tests/rep-poly/RepPolyMcBind.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyMcBind.hs:26:16: error: [GHC-55287] arising from a statement in a monad comprehension does not have a fixed runtime representation. Its type is: - ma0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + ma0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a monad comprehension: x <- undefined :: ma In the expression: [() | x <- undefined :: ma] ===================================== testsuite/tests/rep-poly/RepPolyMcBody.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyMcBody.hs:30:16: error: [GHC-55287] arising from a statement in a monad comprehension does not have a fixed runtime representation. Its type is: - ma0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + ma0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a monad comprehension: True In the expression: [() | True] ===================================== testsuite/tests/rep-poly/RepPolyMcGuard.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyMcGuard.hs:30:16: error: [GHC-55287] arising from a statement in a monad comprehension does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + a0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a monad comprehension: undefined In the expression: [() | undefined] ===================================== testsuite/tests/rep-poly/RepPolyNPlusK.stderr ===================================== @@ -3,4 +3,4 @@ RepPolyNPlusK.hs:22:1: error: [GHC-55287] The first pattern in the equation for ‘foo’ does not have a fixed runtime representation. Its type is: - a :: TYPE rep1 + a :: TYPE rep2 ===================================== testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr ===================================== @@ -17,8 +17,8 @@ RepPolyRecordUpdate.hs:13:9: error: [GHC-55287] • The record update at field ‘fld’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c1 - Cannot unify ‘rep’ with the type variable ‘c1’ + a0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a record update at field ‘fld’, with type constructor ‘X’ ===================================== testsuite/tests/rep-poly/RepPolyRule1.stderr ===================================== @@ -3,8 +3,8 @@ RepPolyRule1.hs:11:51: error: [GHC-55287] • The argument ‘x’ of ‘f’ does not have a fixed runtime representation. Its type is: - a1 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + a1 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In the first argument of ‘f’, namely ‘x’ In the expression: f x @@ -16,8 +16,8 @@ RepPolyRule1.hs:11:55: error: [GHC-55287] • The argument ‘x’ of ‘f’ does not have a fixed runtime representation. Its type is: - a1 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + a1 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In the expression: x When checking the rewrite rule "f_id" ===================================== testsuite/tests/rep-poly/RepPolyTupleSection.stderr ===================================== @@ -3,8 +3,8 @@ RepPolyTupleSection.hs:11:7: error: [GHC-55287] • The second component of the tuple section does not have a fixed runtime representation. Its type is: - t0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ + t1 :: TYPE t0 + Cannot unify ‘r’ with the type variable ‘t0’ because it is not a concrete ‘RuntimeRep’. • In the expression: (# 3#, #) In an equation for ‘foo’: foo = (# 3#, #) ===================================== testsuite/tests/rep-poly/T12709.stderr ===================================== @@ -3,8 +3,8 @@ T12709.hs:28:13: error: [GHC-55287] • The argument ‘1’ of ‘(+)’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + a0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In the expression: 1 + 2 + 3 + 4 In an equation for ‘u’: u = 1 + 2 + 3 + 4 ===================================== testsuite/tests/rep-poly/T12973.stderr ===================================== @@ -3,8 +3,8 @@ T12973.hs:13:7: error: [GHC-55287] • The argument ‘3’ of ‘(+)’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ + a0 :: TYPE r0 + Cannot unify ‘r’ with the type variable ‘r0’ because it is not a concrete ‘RuntimeRep’. • In the expression: 3 + 4 In an equation for ‘foo’: foo = 3 + 4 ===================================== testsuite/tests/rep-poly/T13929.stderr ===================================== @@ -3,8 +3,8 @@ T13929.hs:29:24: error: [GHC-55287] • The tuple argument in first position does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘rf’ with the type variable ‘c0’ + a0 :: TYPE k00 + Cannot unify ‘rf’ with the type variable ‘k00’ because it is not a concrete ‘RuntimeRep’. • In the expression: (# gunbox x, gunbox y #) In an equation for ‘gunbox’: ===================================== testsuite/tests/rep-poly/T19615.stderr ===================================== @@ -3,8 +3,8 @@ T19615.hs:17:21: error: [GHC-55287] • The argument ‘(f x)’ of ‘lift'’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r'’ with the type variable ‘c0’ + a0 :: TYPE r0 + Cannot unify ‘r'’ with the type variable ‘r0’ because it is not a concrete ‘RuntimeRep’. • In the first argument of ‘lift'’, namely ‘(f x)’ In the expression: lift' (f x) id ===================================== testsuite/tests/rep-poly/T19709b.stderr ===================================== @@ -3,8 +3,8 @@ T19709b.hs:11:15: error: [GHC-55287] • The argument ‘(error @Any "e2")’ of ‘levfun’ does not have a fixed runtime representation. Its type is: - a1 :: TYPE c0 - Cannot unify ‘Any’ with the type variable ‘c0’ + a1 :: TYPE r0 + Cannot unify ‘Any’ with the type variable ‘r0’ because it is not a concrete ‘RuntimeRep’. • In the first argument of ‘levfun’, namely ‘(error @Any "e2")’ In the first argument of ‘seq’, namely ‘levfun (error @Any "e2")’ ===================================== testsuite/tests/rep-poly/T23051.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash #-} +module M where + +import GHC.Exts + +i :: forall k (f :: k -> RuntimeRep) (g :: k) (a :: TYPE (f g)). a -> a +i = i + +x = i 0# ===================================== testsuite/tests/rep-poly/T23051.stderr ===================================== @@ -0,0 +1,10 @@ + +T23051.hs:9:7: error: [GHC-18872] + • Couldn't match kind ‘IntRep’ with ‘f0 g0’ + When matching types + a :: TYPE (f0 g0) + Int# :: TYPE IntRep + • In the first argument of ‘i’, namely ‘0#’ + In the expression: i 0# + In an equation for ‘x’: x = i 0# + • Relevant bindings include x :: a (bound at T23051.hs:9:1) ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -113,3 +113,6 @@ test('RepPolyTuple2', normal, compile_fail, ['']) ## see #21683 ## test('T21650_a', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## ############################################################################### + + +test('T23051', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0decae7121524790d5c907274bafac966839487 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0decae7121524790d5c907274bafac966839487 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 14:49:39 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 21 Mar 2023 10:49:39 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] WIP: Better Hash Message-ID: <6419c403d6fd8_90da1a81c9a4270967@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 85d2e6b4 by romes at 2023-03-21T14:49:21+00:00 WIP: Better Hash Co-author: @mpickering TODO: Fix identifier of rts which is depended on. What about the simple identifiers in haddocks? Perhaps we only need the full unitid for the pacckage databases. If filepaths have hashes then cabal can't parse them The wrong way to handle this. Reverting... Revert "If filepaths have hashes then cabal can't parse them" This reverts commit 91d45aee4e3509fd258c498f5f19b0efedd58fbc. Revert "Revert "If filepaths have hashes then cabal can't parse them"" This reverts commit 4aab197ed680cc5d192c4845c009c4bd1871535e. IWP - - - - - 18 changed files: - hadrian/hadrian.cabal - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - + hadrian/src/Hadrian/Haskell/Hash.hs - + hadrian/src/Hadrian/Haskell/Hash.hs-boot - hadrian/src/Hadrian/Package.hs - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Haddock.hs Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -55,6 +55,7 @@ executable hadrian , Hadrian.BuildPath , Hadrian.Expression , Hadrian.Haskell.Cabal + , Hadrian.Haskell.Hash , Hadrian.Haskell.Cabal.Type , Hadrian.Haskell.Cabal.Parse , Hadrian.Oracles.ArgsHash @@ -163,6 +164,8 @@ executable hadrian , transformers >= 0.4 && < 0.7 , unordered-containers >= 0.2.1 && < 0.3 , text >= 1.2 && < 3 + , cryptohash-sha256 >= 0.11 && < 0.12 + , base16-bytestring >= 0.1.1 && < 1.1.0.0 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Context.hs ===================================== @@ -70,15 +70,15 @@ distDir st = do hostArch <- cabalArchString <$> setting arch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version -pkgFileName :: Package -> String -> String -> Action FilePath -pkgFileName package prefix suffix = do - pid <- pkgIdentifier package +pkgFileName :: Context -> Package -> String -> String -> Action FilePath +pkgFileName context package prefix suffix = do + pid <- pkgUnitId context package return $ prefix ++ pid ++ suffix pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - fileName <- pkgFileName package prefix suffix + fileName <- pkgFileName context package prefix suffix return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. @@ -95,9 +95,9 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile Context {..} = do +pkgHaddockFile context at Context {..} = do root <- buildRoot - version <- pkgIdentifier package + version <- pkgUnitId context package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: @@ -106,7 +106,7 @@ pkgHaddockFile Context {..} = do pkgRegisteredLibraryFile :: Context -> Action FilePath pkgRegisteredLibraryFile context at Context {..} = do libDir <- libPath context - pkgId <- pkgIdentifier package + pkgId <- pkgUnitId context package fileName <- pkgRegisteredLibraryFileName context distDir <- distDir stage return $ if Dynamic `wayUnit` way @@ -115,9 +115,9 @@ pkgRegisteredLibraryFile context at Context {..} = do -- | Just the final filename portion of pkgRegisteredLibraryFile pkgRegisteredLibraryFileName :: Context -> Action FilePath -pkgRegisteredLibraryFileName Context{..} = do +pkgRegisteredLibraryFileName context at Context{..} = do extension <- libsuf stage way - pkgFileName package "libHS" extension + pkgFileName context package "libHS" extension -- | Path to the library file of a given 'Context', e.g.: @@ -136,8 +136,8 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile Context {..} = do - pid <- pkgIdentifier package +pkgConfFile context at Context {..} = do + pid <- pkgUnitId context package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -112,16 +112,24 @@ parseWayUnit = Parsec.choice -- | Parse a @"pkgname-pkgversion"@ string into the package name and the -- integers that make up the package version. -parsePkgId :: Parsec.Parsec String () (String, [Integer]) -parsePkgId = parsePkgId' "" Parsec. "package identifier (-)" +parsePkgId :: Parsec.Parsec String () (String, [Integer], String) +parsePkgId = parseRTS <|> (parsePkgId' "" Parsec. "package identifier (--)") where parsePkgId' currName = do s <- Parsec.many1 Parsec.alphaNum _ <- Parsec.char '-' let newName = if null currName then s else currName ++ "-" ++ s - Parsec.choice [ (newName,) <$> parsePkgVersion + Parsec.choice [ (,,) newName <$> parsePkgVersion <*> (Parsec.char '-' *> parsePkgHash) , parsePkgId' newName ] + parseRTS = do + _ <- Parsec.string "rts" <* Parsec.char '-' + v <- parsePkgVersion + pure ("rts", v, "") + +parsePkgHash :: Parsec.Parsec String () String +parsePkgHash = Parsec.many1 Parsec.alphaNum + -- | Parse "."-separated integers that describe a package's version. parsePkgVersion :: Parsec.Parsec String () [Integer] parsePkgVersion = fmap reverse (parsePkgVersion' []) ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -10,8 +10,8 @@ -- Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( - pkgVersion, pkgIdentifier, pkgSynopsis, pkgDescription, pkgDependencies, - pkgGenericDescription, cabalArchString, cabalOsString, + pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, + pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString ) where import Development.Shake @@ -20,20 +20,13 @@ import Distribution.PackageDescription (GenericPackageDescription) import Hadrian.Haskell.Cabal.Type import Hadrian.Oracles.Cabal import Hadrian.Package +import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId) + -- | Read a Cabal file and return the package version. The Cabal file is tracked. pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData --- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0 at . --- The Cabal file is tracked. -pkgIdentifier :: Package -> Action String -pkgIdentifier package = do - cabal <- readPackageData package - return $ if null (version cabal) - then name cabal - else name cabal ++ "-" ++ version cabal - -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. pkgSynopsis :: Package -> Action String pkgSynopsis = fmap synopsis . readPackageData @@ -72,3 +65,4 @@ cabalOsString "mingw32" = "windows" cabalOsString "darwin" = "osx" cabalOsString "solaris2" = "solaris" cabalOsString other = other + ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -345,7 +345,7 @@ registerPackage rs context = do pd <- packageDescription <$> readContextData context db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context)) dist_dir <- Context.buildPath context - pid <- pkgIdentifier (package context) + pid <- pkgUnitId context (package context) -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path -- from the local build info @lbi at . lbi <- liftIO $ C.getPersistBuildConfig cPath @@ -357,12 +357,12 @@ registerPackage rs context = do -- This is copied and simplified from Cabal, because we want to install the package -- into a different package database to the one it was configured against. register :: FilePath - -> FilePath + -> String -- ^ Package Identifier -> FilePath -> C.PackageDescription -> LocalBuildInfo -> IO () -register pkg_db conf_file build_dir pd lbi +register pkg_db pid build_dir pd lbi = withLibLBI pd lbi $ \lib clbi -> do absPackageDBs <- C.absolutePackageDBPaths packageDbs @@ -373,13 +373,13 @@ register pkg_db conf_file build_dir pd lbi writeRegistrationFile installedPkgInfo where - regFile = conf_file + regFile = pkg_db pid <.> "conf" reloc = relocatable lbi -- Using a specific package db here is why we have to copy the function from Cabal. packageDbs = [C.SpecificPackageDB pkg_db] writeRegistrationFile installedPkgInfo = do - writeUTF8File (pkg_db regFile <.> "conf") (CP.showInstalledPackageInfo installedPkgInfo) + writeUTF8File regFile (CP.showInstalledPackageInfo installedPkgInfo) -- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs at . ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -0,0 +1,245 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where + +import Development.Shake + +import Hadrian.Haskell.Cabal.Type as C +import Hadrian.Haskell.Cabal +import Hadrian.Oracles.Cabal +import Hadrian.Package + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as BS +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import Data.List +import Context.Type +import Oracles.Setting +import Hadrian.Target +import Hadrian.Expression +import Builder +import Flavour.Type +import Settings +import Way.Type +import Way +import Packages +import Development.Shake.Classes +import Control.Monad + + +-- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd at . +-- This needs to be an oracle so it's cached +pkgUnitId :: Context -> Package -> Action String +pkgUnitId ctx' pkg = do + let ctx = ctx'{package = pkg} + pid <- pkgSimpleIdentifier (package ctx) + phash <- pkgHash ctx + if pkgName pkg == "rts" + -- The Unit-id will change depending on the way... rTS BReaks. At some + -- point it's not even clear which way we're building + then pure pid + else do + -- Other boot packages still hardcode their unit-id to just , but we + -- can have hadrian generate a different unit-id for them just as cabal does + -- because the boot packages unit-ids are overriden by setting -this-unit-id + -- in the cabal file + -- liftIO $ print $ pid <> "-" <> truncateHash 4 phash + pure $ pid <> "-" <> truncateHash 4 phash + + where + truncateHash :: Int -> String -> String + truncateHash = take + +-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . +-- The Cabal file is tracked. +-- +-- For an identifier complete with the hash use 'pkgUnitId' +pkgSimpleIdentifier :: Package -> Action String +pkgSimpleIdentifier package = do + cabal <- readPackageData package + return $ if null (version cabal) + then C.name cabal + else C.name cabal ++ "-" ++ version cabal + +data PackageHashInputs = PackageHashInputs { + pkgHashPkgId :: String, -- ^ name-version + pkgHashComponent :: PackageType, + pkgHashSourceHash :: BS.ByteString, + -- pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion), + pkgHashDirectDeps :: Set.Set String, + pkgHashOtherConfig :: PackageHashConfigInputs + } + +-- | Those parts of the package configuration that contribute to the +-- package hash computed by hadrian (which is simpler than cabal's). +-- +-- setting in Oracle.setting, which come from system.config +data PackageHashConfigInputs = PackageHashConfigInputs { + pkgHashCompilerId :: String, + pkgHashPlatform :: String, + pkgHashFlagAssignment :: [String], -- complete not partial + -- pkgHashConfigureScriptArgs :: [String], -- just ./configure for build-type Configure + pkgHashVanillaLib :: Bool, + pkgHashSharedLib :: Bool, + pkgHashDynExe :: Bool, + pkgHashFullyStaticExe :: Bool, + pkgHashGHCiLib :: Bool, + pkgHashProfLib :: Bool, + pkgHashProfExe :: Bool, +-- pkgHashProfLibDetail :: ProfDetailLevel, +-- pkgHashProfExeDetail :: ProfDetailLevel, + pkgHashCoverage :: Bool, + pkgHashOptimization :: Int, + pkgHashSplitObjs :: Bool, + pkgHashSplitSections :: Bool, + pkgHashStripLibs :: Bool, + pkgHashStripExes :: Bool, +-- pkgHashDebugInfo :: DebugInfoLevel, + pkgHashProgramArgs :: Map String [String], + pkgHashExtraLibDirs :: [FilePath], + pkgHashExtraLibDirsStatic :: [FilePath], + pkgHashExtraFrameworkDirs :: [FilePath], + pkgHashExtraIncludeDirs :: [FilePath] + -- pkgHashProgPrefix :: Maybe PathTemplate, + -- pkgHashProgSuffix :: Maybe PathTemplate, + -- pkgHashPackageDbs :: [Maybe PackageDB] + } + deriving Show + +newtype PkgHashKey = PkgHashKey Context + deriving (Binary, Eq, Hashable, NFData, Show, Typeable) +type instance RuleResult PkgHashKey = String + +pkgHash :: Context -> Action String +pkgHash = askOracle . PkgHashKey + +-- TODO: Needs to be oracle to be cached? Called lots of times +pkgHashOracle :: Rules () +pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do + -- RECURSIVE ORACLE: ctx_data <- readContextData ctx + pkg_data <- readPackageData (package ctx) + name <- pkgSimpleIdentifier (package ctx) + let stag = stage ctx + liftIO $ print ("Package and Package Dependencies", package ctx, packageDependencies pkg_data) + stagePkgs <- stagePackages stag + depsHashes <- mapM (\pkg -> pkgHash (ctx { package = pkg })) [pkg | pkg <- packageDependencies pkg_data, pkg `elem` stagePkgs] + liftIO $ print ("Pkg Deps Hashes", depsHashes) + flav <- flavour + let flavourArgs = args flav + + targetOs <- setting TargetOs + let pkgHashCompilerId = "" + pkgHashPlatform = targetOs + libWays <- interpretInContext ctx (libraryWays flav) + dyn_ghc <- dynamicGhcPrograms flav + flags <- interpret (target ctx (Cabal Flags stag) [] []) flavourArgs + let pkgHashFlagAssignment = flags + pkgHashConfigureScriptArgs = "" + pkgHashVanillaLib = vanilla `Set.member` libWays + pkgHashSharedLib = dynamic `Set.member` libWays + pkgHashDynExe = dyn_ghc + -- TODO: fullyStatic flavour transformer + pkgHashFullyStaticExe = False + pkgHashGHCiLib = False + pkgHashProfLib = profiling `Set.member` libWays + pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag + pkgHashCoverage = False -- Can't configure this + pkgHashOptimization = 0 -- TODO: A bit tricky to configure + pkgHashSplitObjs = False -- Deprecated + pkgHashSplitSections = ghcSplitSections flav + pkgHashStripExes = False + pkgHashStripLibs = False + pkgHashDebugInfo = undefined + + -- ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs + let pkgHashProgramArgs = mempty -- Map.singleton "ghc" ghcArgs + pkgHashExtraLibDirs = [] + pkgHashExtraLibDirsStatic = [] + pkgHashExtraFrameworkDirs = [] + pkgHashExtraIncludeDirs = [] + + let other_config = PackageHashConfigInputs{..} + + return $ BS.unpack $ Base16.encode $ SHA256.hash $ + renderPackageHashInputs $ PackageHashInputs + { + pkgHashPkgId = name + , pkgHashComponent = pkgType (package ctx) + , pkgHashSourceHash = "" + , pkgHashDirectDeps = Set.empty + , pkgHashOtherConfig = other_config + } + +prettyShow, showHashValue :: Show a => a -> String +prettyShow = show +showHashValue = show + +renderPackageHashInputs :: PackageHashInputs -> BS.ByteString +renderPackageHashInputs PackageHashInputs{ + pkgHashPkgId, + pkgHashComponent, + pkgHashSourceHash, + pkgHashDirectDeps, + -- pkgHashPkgConfigDeps, + pkgHashOtherConfig = + PackageHashConfigInputs{..} + } = + -- The purpose of this somewhat laboured rendering (e.g. why not just + -- use show?) is so that existing package hashes do not change + -- unnecessarily when new configuration inputs are added into the hash. + BS.pack $ unlines $ catMaybes $ + [ entry "pkgid" prettyShow pkgHashPkgId +-- , mentry "component" show pkgHashComponent + , entry "src" showHashValue pkgHashSourceHash + {- + , entry "pkg-config-deps" + (intercalate ", " . map (\(pn, mb_v) -> prettyShow pn ++ + case mb_v of + Nothing -> "" + Just v -> " " ++ prettyShow v) + . Set.toList) pkgHashPkgConfigDeps + -} + , entry "deps" (intercalate ", " . map prettyShow + . Set.toList) pkgHashDirectDeps + -- and then all the config + , entry "compilerid" prettyShow pkgHashCompilerId + , entry "platform" prettyShow pkgHashPlatform + , opt "flags" mempty show pkgHashFlagAssignment +-- , opt "configure-script" [] unwords pkgHashConfigureScriptArgs + , opt "vanilla-lib" True prettyShow pkgHashVanillaLib + , opt "shared-lib" False prettyShow pkgHashSharedLib + , opt "dynamic-exe" False prettyShow pkgHashDynExe + , opt "fully-static-exe" False prettyShow pkgHashFullyStaticExe + , opt "ghci-lib" False prettyShow pkgHashGHCiLib + , opt "prof-lib" False prettyShow pkgHashProfLib + , opt "prof-exe" False prettyShow pkgHashProfExe + -- , opt "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail + -- , opt "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail + , opt "hpc" False prettyShow pkgHashCoverage + , opt "optimisation" 0 (show) pkgHashOptimization + , opt "split-objs" False prettyShow pkgHashSplitObjs + , opt "split-sections" False prettyShow pkgHashSplitSections + , opt "stripped-lib" False prettyShow pkgHashStripLibs + , opt "stripped-exe" True prettyShow pkgHashStripExes +-- , opt "debug-info" NormalDebugInfo (show . fromEnum) pkgHashDebugInfo + , opt "extra-lib-dirs" [] unwords pkgHashExtraLibDirs + , opt "extra-lib-dirs-static" [] unwords pkgHashExtraLibDirsStatic + , opt "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs + , opt "extra-include-dirs" [] unwords pkgHashExtraIncludeDirs +-- , opt "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix +-- , opt "prog-suffix" Nothing (maybe "" fromPathTemplate) pkgHashProgSuffix +-- , opt "package-dbs" [] (unwords . map show) pkgHashPackageDbs + + ] ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs + where + entry key format value = Just (key ++ ": " ++ format value) + mentry key format value = fmap (\v -> key ++ ": " ++ format v) value + opt key def format value + | value == def = Nothing + | otherwise = entry key format value ===================================== hadrian/src/Hadrian/Haskell/Hash.hs-boot ===================================== @@ -0,0 +1,8 @@ +module Hadrian.Haskell.Hash where + +import Context.Type +import Hadrian.Package +import Development.Shake + +pkgUnitId :: Context -> Package -> Action String + ===================================== hadrian/src/Hadrian/Package.hs ===================================== @@ -81,4 +81,4 @@ instance NFData PackageType instance Binary Package instance Hashable Package -instance NFData Package \ No newline at end of file +instance NFData Package ===================================== hadrian/src/Rules.hs ===================================== @@ -8,6 +8,7 @@ import qualified Hadrian.Oracles.Cabal.Rules import qualified Hadrian.Oracles.DirectoryContents import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile +import qualified Hadrian.Haskell.Hash import Expression import qualified Oracles.Flavour @@ -142,6 +143,7 @@ oracleRules :: Rules () oracleRules = do Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs Hadrian.Oracles.Cabal.Rules.cabalOracle + Hadrian.Haskell.Hash.pkgHashOracle Hadrian.Oracles.DirectoryContents.directoryContentsOracle Hadrian.Oracles.Path.pathOracle Hadrian.Oracles.TextFile.textFileOracle ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,7 +132,8 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -10,7 +10,7 @@ import Utilities import qualified System.Directory.Extra as IO import Data.Either import Rules.BinaryDist -import Hadrian.Haskell.Cabal (pkgIdentifier) +import Hadrian.Haskell.Cabal (pkgUnitId) import Oracles.Setting {- @@ -54,7 +54,8 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -293,7 +293,7 @@ parsePkgDocTarget root = do _ <- Parsec.string root *> Parsec.optional (Parsec.char '/') _ <- Parsec.string (htmlRoot ++ "/") _ <- Parsec.string "libraries/" - (pkgname, _) <- parsePkgId <* Parsec.char '/' + (pkgname, _, _) <- parsePkgId <* Parsec.char '/' Parsec.choice [ Parsec.try (Parsec.string "haddock-prologue.txt") *> pure (HaddockPrologue pkgname) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -14,6 +14,7 @@ import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting import Hadrian.Haskell.Cabal.Type (PackageData(version)) +import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal (readPackageData) import Packages import Rules.Libffi @@ -487,16 +488,14 @@ generateConfigHs = do trackGenerateHs cProjectName <- getSetting ProjectName cBooterVersion <- getSetting GhcVersion - cProjectVersionMunged <- getSetting ProjectVersionMunged - -- ROMES:TODO:HASH First we attempt a fixed unit-id with version but without hash. - -- - -- We now use a more informative unit-id for ghc. See Note [GHC's Unit Id] - -- in GHC.Unit.Types + -- We now give a unit-id with a version and a hash to ghc. + -- See Note [GHC's Unit Id] in GHC.Unit.Types -- -- It's crucial that the unit-id matches the unit-key -- ghc is no longer -- part of the WiringMap, so we don't to go back and forth between the - -- unit-id and the unit-key -- we take care here that they are the same. - let cProjectUnitId = "ghc-" ++ cProjectVersionMunged -- ROMES:TODO:HASH + -- unit-id and the unit-key -- we take care that they are the same by using + -- 'pkgUnitId' to create the unit-id in both situations. + cProjectUnitId <- expr . (`pkgUnitId` ghc) =<< getContext return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -593,3 +592,5 @@ generatePlatformHostHs = do , "hostPlatformArchOS :: ArchOS" , "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS" ] + + ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -45,7 +45,7 @@ libraryRules = do registerStaticLib :: FilePath -> FilePath -> Action () registerStaticLib root archivePath = do -- Simply need the ghc-pkg database .conf file. - GhcPkgPath _ stage _ (LibA name _ w) + GhcPkgPath _ stage _ (LibA name _ _ w) <- parsePath (parseGhcPkgLibA root) "<.a library (register) path parser>" archivePath @@ -56,7 +56,7 @@ registerStaticLib root archivePath = do -- the second argument. buildStaticLib :: FilePath -> FilePath -> Action () buildStaticLib root archivePath = do - l@(BuildPath _ stage _ (LibA pkgname _ way)) + l@(BuildPath _ stage _ (LibA pkgname _ _ way)) <- parsePath (parseBuildLibA root) "<.a library (build) path parser>" archivePath @@ -75,7 +75,7 @@ buildStaticLib root archivePath = do registerDynamicLib :: FilePath -> String -> FilePath -> Action () registerDynamicLib root suffix dynlibpath = do -- Simply need the ghc-pkg database .conf file. - (GhcPkgPath _ stage _ (LibDyn name _ w _)) + (GhcPkgPath _ stage _ (LibDyn name _ _ w _)) <- parsePath (parseGhcPkgLibDyn root suffix) "" dynlibpath @@ -99,7 +99,7 @@ buildDynamicLib root suffix dynlibpath = do -- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. buildGhciLibO :: FilePath -> FilePath -> Action () buildGhciLibO root ghcilibPath = do - l@(BuildPath _ stage _ (LibGhci _ _ _)) + l@(BuildPath _ stage _ (LibGhci _ _ _ _)) <- parsePath (parseBuildLibGhci root) "<.o ghci lib (build) path parser>" ghcilibPath @@ -134,7 +134,7 @@ files etc. buildPackage :: FilePath -> FilePath -> Action () buildPackage root fp = do - l@(BuildPath _ _ _ (PkgStamp _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp + l@(BuildPath _ _ _ (PkgStamp _ _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp let ctx = stampContext l srcs <- hsSources ctx gens <- interpretInContext ctx generatedDependencies @@ -226,47 +226,47 @@ needLibrary cs = need =<< concatMapM (libraryTargets True) cs -- * Library paths types and parsers --- | > libHS-[_].a -data LibA = LibA String [Integer] Way deriving (Eq, Show) +-- | > libHS--[_].a +data LibA = LibA String [Integer] String Way deriving (Eq, Show) -- | > data DynLibExt = So | Dylib deriving (Eq, Show) --- | > libHS-[_]-ghc. -data LibDyn = LibDyn String [Integer] Way DynLibExt deriving (Eq, Show) +-- | > libHS--[_]-ghc. +data LibDyn = LibDyn String [Integer] String Way DynLibExt deriving (Eq, Show) --- | > HS-[_].o -data LibGhci = LibGhci String [Integer] Way deriving (Eq, Show) +-- | > HS--[_].o +data LibGhci = LibGhci String [Integer] String Way deriving (Eq, Show) -- | Get the 'Context' corresponding to the build path for a given static library. libAContext :: BuildPath LibA -> Context -libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) = +libAContext (BuildPath _ stage pkgpath (LibA pkgname _ _ way)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given GHCi library. libGhciContext :: BuildPath LibGhci -> Context -libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) = +libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ _ way)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given dynamic library. libDynContext :: BuildPath LibDyn -> Context -libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = +libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ _ way _)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given static library. stampContext :: BuildPath PkgStamp -> Context -stampContext (BuildPath _ stage _ (PkgStamp pkgname _ way)) = +stampContext (BuildPath _ stage _ (PkgStamp pkgname _ _ way)) = Context stage pkg way Final where pkg = unsafeFindPackageByName pkgname -data PkgStamp = PkgStamp String [Integer] Way deriving (Eq, Show) +data PkgStamp = PkgStamp String [Integer] String Way deriving (Eq, Show) -- | Parse a path to a ghci library to be built, making sure the path starts @@ -313,34 +313,34 @@ parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext) parseLibAFilename :: Parsec.Parsec String () LibA parseLibAFilename = do _ <- Parsec.string "libHS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- parseWaySuffix vanilla _ <- Parsec.string ".a" - return (LibA pkgname pkgver way) + return (LibA pkgname pkgver pkghash way) -- | Parse the filename of a ghci library to be built into a 'LibGhci' value. parseLibGhciFilename :: Parsec.Parsec String () LibGhci parseLibGhciFilename = do _ <- Parsec.string "HS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId _ <- Parsec.string "." way <- parseWayPrefix vanilla _ <- Parsec.string "o" - return (LibGhci pkgname pkgver way) + return (LibGhci pkgname pkgver pkghash way) -- | Parse the filename of a dynamic library to be built into a 'LibDyn' value. parseLibDynFilename :: String -> Parsec.Parsec String () LibDyn parseLibDynFilename ext = do _ <- Parsec.string "libHS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- addWayUnit Dynamic <$> parseWaySuffix dynamic _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion _ <- Parsec.string ("." ++ ext) - return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) + return (LibDyn pkgname pkgver pkghash way $ if ext == "so" then So else Dylib) parseStamp :: Parsec.Parsec String () PkgStamp parseStamp = do _ <- Parsec.string "stamp-" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- parseWaySuffix vanilla - return (PkgStamp pkgname pkgver way) + return (PkgStamp pkgname pkgver pkghash way) ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeApplications #-} module Rules.Register ( configurePackageRules, registerPackageRules, registerPackages, libraryTargets @@ -20,11 +21,15 @@ import Utilities import Hadrian.Haskell.Cabal.Type import qualified Text.Parsec as Parsec import qualified Data.Set as Set +import qualified Data.Char as Char +import Data.Bifunctor (bimap) import Distribution.Version (Version) -import qualified Distribution.Parsec as Cabal -import qualified Distribution.Types.PackageName as Cabal import qualified Distribution.Types.PackageId as Cabal +import qualified Distribution.Types.PackageName as Cabal +import qualified Distribution.Parsec as Cabal +import qualified Distribution.Parsec.FieldLineStream as Cabal +import qualified Distribution.Compat.CharParsing as CabalCharParsing import qualified Hadrian.Haskell.Cabal.Parse as Cabal import qualified System.Directory as IO @@ -183,7 +188,7 @@ buildConfFinal rs context at Context {..} _conf = do -- so that if any change ends up modifying a library (but not its .conf -- file), we still rebuild things that depend on it. dir <- (-/-) <$> libPath context <*> distDir stage - pkgid <- pkgIdentifier package + pkgid <- pkgUnitId context package files <- liftIO $ (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] @@ -251,11 +256,32 @@ getPackageNameFromConfFile conf takeBaseName conf ++ ": " ++ err Right (name, _) -> return name +-- | Parse a cabal-like name parseCabalName :: String -> Either String (String, Version) -parseCabalName = fmap f . Cabal.eitherParsec +-- Try to parse a name with a hash, but otherwise parse a name without one. +parseCabalName s = bimap show id (Cabal.runParsecParser nameWithHashParser "" $ Cabal.fieldLineStreamFromString s) + <|> fmap f (Cabal.eitherParsec s) where f :: Cabal.PackageId -> (String, Version) f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id) + -- Definition similar to 'Parsec PackageIdentifier' from Cabal but extended + -- with logic for parsing the hash (despite not returning it) + nameWithHashParser :: Cabal.ParsecParser (String, Version) + nameWithHashParser = Cabal.PP $ \_ -> do + xs' <- Parsec.sepBy component (Parsec.char '-') + case reverse xs' of + hash:version_str:xs -> + case Cabal.simpleParsec @Version version_str of + Nothing -> fail ("failed to parse a version from " <> version_str) + Just v -> + if not (null xs) && all (\c -> all (/= '.') c && not (all Char.isDigit c)) xs + then return $ (intercalate "-" (reverse xs), v) + else fail "all digits or a dot in a portion of package name" + _ -> fail "couldn't parse a hash, a version and a name" + where + component = CabalCharParsing.munch1 (\c -> Char.isAlphaNum c || c == '.') + + -- | Return extra library targets. extraTargets :: Context -> Action [FilePath] ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -84,8 +84,9 @@ cabalSetupArgs = builder (Cabal Setup) ? do commonCabalArgs :: Stage -> Args commonCabalArgs stage = do verbosity <- expr getVerbosity + ctx <- getContext pkg <- getPackage - package_id <- expr $ pkgIdentifier pkg + package_id <- expr $ pkgUnitId ctx pkg let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..") mconcat [ -- Don't strip libraries when cross compiling. -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, @@ -101,7 +102,7 @@ commonCabalArgs stage = do , arg "--cabal-file" , arg $ pkgCabalFile pkg , arg "--ipid" - , arg "$pkg-$version" + , arg package_id , arg "--prefix" , arg prefix ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -243,21 +243,24 @@ wayGhcArgs = do , (way == debug || way == debugDynamic) ? pure ["-ticky", "-DTICKY_TICKY"] ] +-- | Args related to correct handling of packages, such as setting +-- -this-unit-id and passing -package-id for dependencies packageGhcArgs :: Args packageGhcArgs = do package <- getPackage + ctx <- getContext ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) -- ROMES: Until the boot compiler no longer needs ghc's -- unit-id to be "ghc", the stage0 compiler must be built -- with `-this-unit-id ghc`, while the wired-in unit-id of -- ghc is correctly set to the unit-id we'll generate for - -- stage1 (set in generateVersionHs in Rules.Generate). + -- stage1 (set in generateConfigHs in Rules.Generate). -- -- However, we don't need to set the unit-id of "ghc" to "ghc" when -- building stage0 because we have a flag in compiler/ghc.cabal.in that is -- sets `-this-unit-id ghc` when hadrian is building stage0, which will -- overwrite this one. - pkgId <- expr $ pkgIdentifier package + pkgId <- expr $ pkgUnitId ctx package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -42,7 +42,7 @@ haddockBuilderArgs = mconcat version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg haddocks <- expr $ haddockDependencies context - haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks] + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgUnitId context p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85d2e6b40e60eb511fecafa3c3a0f7cd3fcd5cb7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85d2e6b40e60eb511fecafa3c3a0f7cd3fcd5cb7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 15:17:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 21 Mar 2023 11:17:46 -0400 Subject: [Git][ghc/ghc][master] Rename () into Unit, (,,...,,) into Tuple (#21294) Message-ID: <6419ca9aa2372_90da1b19c86c29477c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 26 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Types/Name/Cache.hs - compiler/GHC/Types/Name/Ppr.hs - libraries/base/Data/Typeable/Internal.hs - libraries/ghc-prim/GHC/Tuple.hs - libraries/ghc-prim/GHC/Tuple/Prim.hs - testsuite/tests/ghc-api/T18522-dbg-ppr.stdout - testsuite/tests/ghci/scripts/T12550.stdout - testsuite/tests/ghci/scripts/T4127.stdout - testsuite/tests/ghci/scripts/T4175.stdout - testsuite/tests/ghci/scripts/T7627.stdout - testsuite/tests/ghci/scripts/ghci011.stdout - testsuite/tests/hiefile/should_run/HieQueries.stdout - + testsuite/tests/module/TupleTyConUserSyntax.hs - + testsuite/tests/module/TupleTyConUserSyntaxA.hs - testsuite/tests/module/all.T - testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr - testsuite/tests/roles/should_compile/T8958.stderr - testsuite/tests/stranal/sigs/T21119.stderr - testsuite/tests/stranal/sigs/T21888.stderr - testsuite/tests/th/T12478_4.stderr - testsuite/tests/typecheck/should_compile/T18529.stderr - utils/haddock Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -2796,6 +2796,7 @@ Situations in which we apply this special logic: pretendNameIsInScope :: Name -> Bool pretendNameIsInScope n = isBuiltInSyntax n + || isTupleTyConName n || any (n `hasKey`) [ liftedTypeKindTyConKey, unliftedTypeKindTyConKey , liftedDataConKey, unliftedDataConKey ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Builtin.Types ( mkWiredInIdName, -- used in GHC.Types.Id.Make -- * All wired in things - wiredInTyCons, isBuiltInOcc_maybe, isPunOcc_maybe, + wiredInTyCons, isBuiltInOcc_maybe, isTupleTyOcc_maybe, isPunOcc_maybe, -- * Bool boolTy, boolTyCon, boolTyCon_RDR, boolTyConName, @@ -209,6 +209,10 @@ import qualified Data.ByteString.Char8 as BS import Data.Foldable import Data.List ( elemIndex, intersperse ) +import Numeric ( showInt ) + +import Text.Read (readMaybe) +import Data.Char (ord, isDigit) alpha_tyvar :: [TyVar] alpha_tyvar = [alphaTyVar] @@ -734,16 +738,16 @@ Basically it keeps everything uniform. However the /naming/ of the type/data constructors for one-tuples is a bit odd: - 3-tuples: (,,) (,,)# - 2-tuples: (,) (,)# + 3-tuples: Tuple3 (,,)# + 2-tuples: Tuple2 (,)# 1-tuples: ?? - 0-tuples: () ()# + 0-tuples: Unit ()# Zero-tuples have used up the logical name. So we use 'Solo' and 'Solo#' for one-tuples. So in ghc-prim:GHC.Tuple we see the declarations: - data () = () + data Unit = () data Solo a = MkSolo a - data (a,b) = (a,b) + data Tuple2 a b = (a,b) There is no way to write a boxed one-tuple in Haskell using tuple syntax. They can, however, be written using other methods: @@ -852,13 +856,54 @@ isBuiltInOcc_maybe occ = choose_ns tc dc | isTcClsNameSpace ns = tc | isDataConNameSpace ns = dc - | otherwise = pprPanic "tup_name" (ppr occ) + | otherwise = pprPanic "tup_name" (ppr occ <+> parens (pprNameSpace ns)) where ns = occNameSpace occ tup_name boxity arity = choose_ns (getName (tupleTyCon boxity arity)) (getName (tupleDataCon boxity arity)) +isTupleTyOcc_maybe :: Module -> OccName -> Maybe Name +isTupleTyOcc_maybe mod occ + | mod == gHC_TUPLE_PRIM + = match_occ + where + match_occ + | occ == occName unitTyConName = Just unitTyConName + | occ == occName soloTyConName = Just soloTyConName + | otherwise = isTupleNTyOcc_maybe occ +isTupleTyOcc_maybe _ _ = Nothing + + +-- | This is only for Tuple, not for Unit or Solo +isTupleNTyOcc_maybe :: OccName -> Maybe Name +isTupleNTyOcc_maybe occ = + case occNameString occ of + 'T':'u':'p':'l':'e':str | Just n <- readInt str, n > 1 + -> Just (tupleTyConName BoxedTuple n) + _ -> Nothing + +-- | See Note [Small Ints parsing] +readInt :: String -> Maybe Int +readInt s = case s of + [c] | isDigit c -> Just (digit_to_int c) + [c1, c2] | isDigit c1, isDigit c2 + -> Just (digit_to_int c1 * 10 + digit_to_int c2) + _ -> readMaybe s + where + digit_to_int :: Char -> Int + digit_to_int c = ord c - ord '0' + +{- +Note [Small Ints parsing] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Currently, tuples in Haskell have a maximum arity of 64. +To parse strings of length 1 and 2 more efficiently, we +can utilize an ad-hoc solution that matches their characters. +This results in a speedup of up to 40 times compared to using +`readMaybe @Int` on my machine. +-} + -- When resolving names produced by Template Haskell (see thOrigRdrName -- in GHC.ThToHs), we want ghc-prim:GHC.Types.List to yield an Exact name, not -- an Orig name. @@ -872,6 +917,10 @@ isPunOcc_maybe :: Module -> OccName -> Maybe Name isPunOcc_maybe mod occ | mod == gHC_TYPES, occ == occName listTyConName = Just listTyConName + | mod == gHC_TUPLE_PRIM, occ == occName unitTyConName + = Just unitTyConName + | mod == gHC_TUPLE_PRIM + = isTupleNTyOcc_maybe occ isPunOcc_maybe _ _ = Nothing mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName @@ -887,10 +936,15 @@ mkTupleStr Boxed = mkBoxedTupleStr mkTupleStr Unboxed = const mkUnboxedTupleStr mkBoxedTupleStr :: NameSpace -> Arity -> String -mkBoxedTupleStr _ 0 = "()" -mkBoxedTupleStr ns 1 | isDataConNameSpace ns = "MkSolo" -- See Note [One-tuples] -mkBoxedTupleStr _ 1 = "Solo" -- See Note [One-tuples] -mkBoxedTupleStr _ ar = '(' : commas ar ++ ")" +mkBoxedTupleStr ns 0 + | isDataConNameSpace ns = "()" + | otherwise = "Unit" +mkBoxedTupleStr ns 1 + | isDataConNameSpace ns = "MkSolo" -- See Note [One-tuples] + | otherwise = "Solo" +mkBoxedTupleStr ns ar + | isDataConNameSpace ns = '(' : commas ar ++ ")" + | otherwise = "Tuple" ++ showInt ar "" mkUnboxedTupleStr :: Arity -> String mkUnboxedTupleStr 0 = "(##)" @@ -1052,7 +1106,7 @@ mk_tuple Boxed arity = (tycon, tuple_con) boxity = Boxed modu = gHC_TUPLE_PRIM tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq - (ATyCon tycon) BuiltInSyntax + (ATyCon tycon) UserSyntax dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq (AConLike (RealDataCon tuple_con)) BuiltInSyntax tc_uniq = mkTupleTyConUnique boxity arity @@ -1126,6 +1180,9 @@ mk_ctuple arity = (tycon, tuple_con, sc_sel_ids_arr) unitTyCon :: TyCon unitTyCon = tupleTyCon Boxed 0 +unitTyConName :: Name +unitTyConName = tyConName unitTyCon + unitTyConKey :: Unique unitTyConKey = getUnique unitTyCon @@ -1138,6 +1195,9 @@ unitDataConId = dataConWorkId unitDataCon soloTyCon :: TyCon soloTyCon = tupleTyCon Boxed 1 +soloTyConName :: Name +soloTyConName = tyConName soloTyCon + pairTyCon :: TyCon pairTyCon = tupleTyCon Boxed 2 ===================================== compiler/GHC/Builtin/Uniques.hs ===================================== @@ -19,6 +19,7 @@ module GHC.Builtin.Uniques -- *** Vanilla , mkTupleTyConUnique , mkTupleDataConUnique + , isTupleTyConUnique -- *** Constraint , mkCTupleTyConUnique , mkCTupleDataConUnique @@ -266,6 +267,17 @@ mkTupleTyConUnique :: Boxity -> Arity -> Unique mkTupleTyConUnique Boxed a = mkUnique '4' (2*a) mkTupleTyConUnique Unboxed a = mkUnique '5' (2*a) +-- | This function is an inverse of `mkTupleTyConUnique` +isTupleTyConUnique :: Unique -> Maybe (Boxity, Arity) +isTupleTyConUnique u = + case (tag, i) of + ('4', 0) -> Just (Boxed, arity) + ('5', 0) -> Just (Unboxed, arity) + _ -> Nothing + where + (tag, n) = unpkUnique u + (arity, i) = quotRem n 2 + getTupleTyConName :: Boxity -> Int -> Name getTupleTyConName boxity n = case n `divMod` 2 of ===================================== compiler/GHC/Types/Name.hs ===================================== @@ -64,7 +64,7 @@ module GHC.Types.Name ( isSystemName, isInternalName, isExternalName, isTyVarName, isTyConName, isDataConName, isValName, isVarName, isDynLinkName, - isWiredInName, isWiredIn, isBuiltInSyntax, + isWiredInName, isWiredIn, isBuiltInSyntax, isTupleTyConName, isHoleName, wiredInNameTyThing_maybe, nameIsLocalOrFrom, nameIsExternalOrFrom, nameIsHomePackage, @@ -103,6 +103,8 @@ import GHC.Utils.Panic import Control.DeepSeq import Data.Data import qualified Data.Semigroup as S +import GHC.Types.Basic (Boxity(Boxed)) +import GHC.Builtin.Uniques (isTupleTyConUnique) {- ************************************************************************ @@ -282,6 +284,9 @@ isBuiltInSyntax :: Name -> Bool isBuiltInSyntax (Name {n_sort = WiredIn _ _ BuiltInSyntax}) = True isBuiltInSyntax _ = False +isTupleTyConName :: Name -> Bool +isTupleTyConName = isJust . isTupleTyConUnique . getUnique + isExternalName (Name {n_sort = External _}) = True isExternalName (Name {n_sort = WiredIn _ _ _}) = True isExternalName _ = False @@ -339,7 +344,14 @@ is_interactive_or_from from mod = from == mod || isInteractiveModule mod -- Return the pun for a name if available. -- Used for pretty-printing under ListTuplePuns. namePun_maybe :: Name -> Maybe FastString -namePun_maybe name | getUnique name == getUnique listTyCon = Just (fsLit "[]") +namePun_maybe name + | getUnique name == getUnique listTyCon = Just (fsLit "[]") + + | Just (Boxed, ar) <- isTupleTyConUnique (getUnique name) + , ar /= 1 = Just (fsLit $ '(' : commas ar ++ ")") + where + commas ar = replicate (ar-1) ',' + namePun_maybe _ = Nothing nameIsLocalOrFrom :: Module -> Name -> Bool ===================================== compiler/GHC/Types/Name/Cache.hs ===================================== @@ -1,4 +1,3 @@ - {-# LANGUAGE RankNTypes #-} -- | The Name Cache @@ -30,6 +29,8 @@ import GHC.Utils.Panic import Control.Concurrent.MVar import Control.Monad +import Control.Applicative + {- @@ -58,8 +59,8 @@ site, we fix it up. Note [Built-in syntax and the OrigNameCache] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Built-in syntax like tuples and unboxed sums are quite ubiquitous. To lower -their cost we use two tricks, +Built-in syntax like unboxed sums and punned syntax like tuples are quite +ubiquitous. To lower their cost we use two tricks, a. We specially encode tuple and sum Names in interface files' symbol tables to avoid having to look up their names while loading interface files. @@ -69,13 +70,14 @@ their cost we use two tricks, in GHC.Iface.Binary and for details. b. We don't include them in the Orig name cache but instead parse their - OccNames (in isBuiltInOcc_maybe) to avoid bloating the name cache with - them. + OccNames (in isBuiltInOcc_maybe and isPunOcc_maybe) to avoid bloating + the name cache with them. Why is the second measure necessary? Good question; afterall, 1) the parser -emits built-in syntax directly as Exact RdrNames, and 2) built-in syntax never -needs to looked-up during interface loading due to (a). It turns out that there -are two reasons why we might look up an Orig RdrName for built-in syntax, +emits built-in and punned syntax directly as Exact RdrNames, and 2) built-in +and punned syntax never needs to looked-up during interface loading due to (a). +It turns out that there are two reasons why we might look up an Orig RdrName +for built-in and punned syntax, * If you use setRdrNameSpace on an Exact RdrName it may be turned into an Orig RdrName. @@ -103,7 +105,7 @@ takeUniqFromNameCache (NameCache c _) = uniqFromMask c lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name lookupOrigNameCache nc mod occ | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_TUPLE_PRIM - , Just name <- isBuiltInOcc_maybe occ + , Just name <- isBuiltInOcc_maybe occ <|> isPunOcc_maybe mod occ = -- See Note [Known-key names], 3(c) in GHC.Builtin.Names -- Special case for tuples; there are too many -- of them to pre-populate the original-name cache ===================================== compiler/GHC/Types/Name/Ppr.hs ===================================== @@ -23,6 +23,7 @@ import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Builtin.Types.Prim ( fUNTyConName ) import GHC.Builtin.Types +import Data.Maybe (isJust) {- @@ -120,7 +121,9 @@ mkQualName env = qual_name where , tYPETyConName , fUNTyConName, unrestrictedFunTyConName , oneDataConName + , listTyConName , manyDataConName ] + || isJust (isTupleTyOcc_maybe mod occ) right_name gre = greDefinitionModule gre == Just mod ===================================== libraries/base/Data/Typeable/Internal.hs ===================================== @@ -91,7 +91,9 @@ import GHC.Base import qualified GHC.Arr as A import Data.Either (Either (..)) import Data.Type.Equality -import GHC.List ( splitAt, foldl', elem ) +import GHC.List ( splitAt, foldl', elem, replicate ) +import GHC.Unicode (isDigit) +import GHC.Num ((-), (+), (*)) import GHC.Word import GHC.Show import GHC.TypeLits ( KnownChar, charVal', KnownSymbol, symbolVal' @@ -879,9 +881,12 @@ showTypeable _ rep -- Take care only to render saturated tuple tycon applications -- with tuple notation (#14341). - | isTupleTyCon tc, + | Just _ <- isTupleTyCon tc, Just _ <- TrType `eqTypeRep` typeRepKind rep = showChar '(' . showArgs (showChar ',') tys . showChar ')' + -- Print (,,,) instead of Tuple4 + | Just n <- isTupleTyCon tc, [] <- tys = + showChar '(' . showString (replicate (n-1) ',') . showChar ')' where (tc, tys) = splitApps rep showTypeable _ (TrTyCon {trTyCon = tycon, trKindVars = []}) = showTyCon tycon @@ -970,10 +975,26 @@ funTyCon = typeRepTyCon (typeRep @(->)) isListTyCon :: TyCon -> Bool isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep []) -isTupleTyCon :: TyCon -> Bool +isTupleTyCon :: TyCon -> Maybe Int isTupleTyCon tc - | ('(':',':_) <- tyConName tc = True - | otherwise = False + | tyConPackage tc == "ghc-prim" + , tyConModule tc == "GHC.Tuple.Prim" + = case tyConName tc of + "Unit" -> Just 0 + 'T' : 'u' : 'p' : 'l' : 'e' : arity -> readTwoDigits arity + _ -> Nothing + | otherwise = Nothing + +-- | See Note [Small Ints parsing] in GHC.Builtin.Types +readTwoDigits :: String -> Maybe Int +readTwoDigits s = case s of + [c] | isDigit c -> Just (digit_to_int c) + [c1, c2] | isDigit c1, isDigit c2 + -> Just (digit_to_int c1 * 10 + digit_to_int c2) + _ -> Nothing + where + digit_to_int :: Char -> Int + digit_to_int c = ord c - ord '0' -- This is only an approximation. We don't have the general -- character-classification machinery here, so we just do our best. ===================================== libraries/ghc-prim/GHC/Tuple.hs ===================================== @@ -5,7 +5,7 @@ -- Module : GHC.Tuple -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/ghc-prim/LICENSE) --- +-- -- Maintainer : libraries at haskell.org -- Stability : experimental -- Portability : non-portable (GHC extensions) ===================================== libraries/ghc-prim/GHC/Tuple/Prim.hs ===================================== @@ -22,16 +22,16 @@ import GHC.CString () -- Make sure we do it first, so that the default () -- Double and Integer aren't available yet --- | The unit datatype @()@ has one non-undefined member, the nullary +-- | The unit datatype @Unit@ has one non-undefined member, the nullary -- constructor @()@. -data () = () +data Unit = () -- The desugarer uses 1-tuples, --- but "()" is already used up for 0-tuples +-- but "Unit" is already used up for 0-tuples -- See Note [One-tuples] in GHC.Builtin.Types --- | @Solo@ is the canonical lifted 1-tuple, just like '(,)' is the canonical --- lifted 2-tuple (pair) and '(,,)' is the canonical lifted 3-tuple (triple). +-- | @Solo@ is the canonical lifted 1-tuple, just like 'Tuple2' is the canonical +-- lifted 2-tuple (pair) and 'Tuple3' is the canonical lifted 3-tuple (triple). -- -- The most important feature of @Solo@ is that it is possible to force its -- "outside" (usually by pattern matching) without forcing its "inside", @@ -107,146 +107,148 @@ getSolo :: Solo a -> a -- to have getSolo as its own separate function (#20562) getSolo (MkSolo a) = a -data (a,b) = (a,b) -data (a,b,c) = (a,b,c) -data (a,b,c,d) = (a,b,c,d) -data (a,b,c,d,e) = (a,b,c,d,e) -data (a,b,c,d,e,f) = (a,b,c,d,e,f) -data (a,b,c,d,e,f,g) = (a,b,c,d,e,f,g) -data (a,b,c,d,e,f,g,h) = (a,b,c,d,e,f,g,h) -data (a,b,c,d,e,f,g,h,i) = (a,b,c,d,e,f,g,h,i) -data (a,b,c,d,e,f,g,h,i,j) = (a,b,c,d,e,f,g,h,i,j) -data (a,b,c,d,e,f,g,h,i,j,k) = (a,b,c,d,e,f,g,h,i,j,k) -data (a,b,c,d,e,f,g,h,i,j,k,l) = (a,b,c,d,e,f,g,h,i,j,k,l) -data (a,b,c,d,e,f,g,h,i,j,k,l,m) = (a,b,c,d,e,f,g,h,i,j,k,l,m) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) +type Tuple0 = Unit +type Tuple1 = Solo +data Tuple2 a b = (a,b) +data Tuple3 a b c = (a,b,c) +data Tuple4 a b c d = (a,b,c,d) +data Tuple5 a b c d e = (a,b,c,d,e) +data Tuple6 a b c d e f = (a,b,c,d,e,f) +data Tuple7 a b c d e f g = (a,b,c,d,e,f,g) +data Tuple8 a b c d e f g h = (a,b,c,d,e,f,g,h) +data Tuple9 a b c d e f g h i = (a,b,c,d,e,f,g,h,i) +data Tuple10 a b c d e f g h i j = (a,b,c,d,e,f,g,h,i,j) +data Tuple11 a b c d e f g h i j k = (a,b,c,d,e,f,g,h,i,j,k) +data Tuple12 a b c d e f g h i j k l = (a,b,c,d,e,f,g,h,i,j,k,l) +data Tuple13 a b c d e f g h i j k l m = (a,b,c,d,e,f,g,h,i,j,k,l,m) +data Tuple14 a b c d e f g h i j k l m n = (a,b,c,d,e,f,g,h,i,j,k,l,m,n) +data Tuple15 a b c d e f g h i j k l m n o = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) +data Tuple16 a b c d e f g h i j k l m n o p = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) +data Tuple17 a b c d e f g h i j k l m n o p q = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) +data Tuple18 a b c d e f g h i j k l m n o p q r = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) +data Tuple19 a b c d e f g h i j k l m n o p q r s = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) +data Tuple20 a b c d e f g h i j k l m n o p q r s t = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) +data Tuple21 a b c d e f g h i j k l m n o p q r s t u = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) +data Tuple22 a b c d e f g h i j k l m n o p q r s t u v = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) +data Tuple23 a b c d e f g h i j k l m n o p q r s t u v w = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) +data Tuple24 a b c d e f g h i j k l m n o p q r s t u v w x = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x) +data Tuple25 a b c d e f g h i j k l m n o p q r s t u v w x y = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y) +data Tuple26 a b c d e f g h i j k l m n o p q r s t u v w x y z = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1) +data Tuple27 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1) +data Tuple28 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1) +data Tuple29 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1) +data Tuple30 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1) +data Tuple31 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1) +data Tuple32 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1) +data Tuple33 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1) +data Tuple34 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1) +data Tuple35 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1) +data Tuple36 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1) +data Tuple37 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1) +data Tuple38 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1) +data Tuple39 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1) +data Tuple40 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1) +data Tuple41 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1) +data Tuple42 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1) +data Tuple43 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1) +data Tuple44 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1) +data Tuple45 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,r1,s1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1) +data Tuple46 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1) +data Tuple47 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1) +data Tuple48 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1) +data Tuple49 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1) +data Tuple50 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1) +data Tuple51 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1) +data Tuple52 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1,a2) +data Tuple53 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2) +data Tuple54 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2) +data Tuple55 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2) +data Tuple56 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2) +data Tuple57 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2) +data Tuple58 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2) +data Tuple59 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2) +data Tuple60 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2) +data Tuple61 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2) +data Tuple62 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2) +data Tuple63 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 k2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2) -data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, - r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2) +data Tuple64 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 + r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 k2 l2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2) ===================================== testsuite/tests/ghc-api/T18522-dbg-ppr.stdout ===================================== @@ -1,2 +1 @@ -forall k{tv}[tv] {j{tv}[tv]}. -forall a{tv}[tv] b{tv}[tv] -> (){(w) tc} +forall k{tv}[tv] {j{tv}[tv]}. forall a{tv}[tv] b{tv}[tv] -> () ===================================== testsuite/tests/ghci/scripts/T12550.stdout ===================================== @@ -23,6 +23,11 @@ class Functor f where (<$) ∷ ∀ a b. a → f b → f a {-# MINIMAL fmap #-} -- Defined in ‘GHC.Base’ +instance ∀ r. Functor ((->) r) -- Defined in ‘GHC.Base’ +instance Functor IO -- Defined in ‘GHC.Base’ +instance Functor [] -- Defined in ‘GHC.Base’ +instance Functor Maybe -- Defined in ‘GHC.Base’ +instance Functor Solo -- Defined in ‘GHC.Base’ instance ∀ a. Functor ((,) a) -- Defined in ‘GHC.Base’ instance ∀ a b. Functor ((,,) a b) -- Defined in ‘GHC.Base’ instance ∀ a b c. Functor ((,,,) a b c) -- Defined in ‘GHC.Base’ @@ -32,11 +37,6 @@ instance ∀ a b c d e. Functor ((,,,,,) a b c d e) -- Defined in ‘GHC.Base’ instance ∀ a b c d e f. Functor ((,,,,,,) a b c d e f) -- Defined in ‘GHC.Base’ -instance ∀ r. Functor ((->) r) -- Defined in ‘GHC.Base’ -instance Functor IO -- Defined in ‘GHC.Base’ -instance Functor [] -- Defined in ‘GHC.Base’ -instance Functor Maybe -- Defined in ‘GHC.Base’ -instance Functor Solo -- Defined in ‘GHC.Base’ instance ∀ a. Functor (Either a) -- Defined in ‘Data.Either’ instance ∀ (f ∷ ★ → ★) (g ∷ ★ → ★). (Functor f, Functor g) ⇒ ===================================== testsuite/tests/ghci/scripts/T4127.stdout ===================================== @@ -1 +1 @@ -[InstanceD Nothing [] (AppT (ConT GHC.Base.Monad) (AppT (ConT GHC.Tuple.Prim.(,)) (VarT a_0))) [ValD (VarP GHC.Base.>>=) (NormalB (VarE GHC.Err.undefined)) []]] +[InstanceD Nothing [] (AppT (ConT GHC.Base.Monad) (AppT (ConT GHC.Tuple.Prim.Tuple2) (VarT a_0))) [ValD (VarP GHC.Base.>>=) (NormalB (VarE GHC.Err.undefined)) []]] ===================================== testsuite/tests/ghci/scripts/T4175.stdout ===================================== @@ -22,8 +22,8 @@ type family E a where E () = Bool E Int = String -- Defined at T4175.hs:25:1 -type () :: * -data () = () +type Unit :: * +data Unit = () -- Defined in ‘GHC.Tuple.Prim’ instance [safe] C () -- Defined at T4175.hs:22:10 instance Monoid () -- Defined in ‘GHC.Base’ ===================================== testsuite/tests/ghci/scripts/T7627.stdout ===================================== @@ -1,5 +1,5 @@ -type () :: * -data () = () +type Unit :: * +data Unit = () -- Defined in ‘GHC.Tuple.Prim’ instance Monoid () -- Defined in ‘GHC.Base’ instance Semigroup () -- Defined in ‘GHC.Base’ @@ -16,8 +16,8 @@ data (##) = (##) (##) :: (# #) ( ) :: () (# #) :: (# #) -type (,) :: * -> * -> * -data (,) a b = (,) a b +type Tuple2 :: * -> * -> * +data Tuple2 a b = (,) a b -- Defined in ‘GHC.Tuple.Prim’ instance Traversable ((,) a) -- Defined in ‘Data.Traversable’ instance (Monoid a, Monoid b) => Monoid (a, b) @@ -27,13 +27,13 @@ instance (Semigroup a, Semigroup b) => Semigroup (a, b) instance Foldable ((,) a) -- Defined in ‘Data.Foldable’ instance (Bounded a, Bounded b) => Bounded (a, b) -- Defined in ‘GHC.Enum’ -instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‘GHC.Classes’ -instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’ instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’ -instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’ instance Monoid a => Applicative ((,) a) -- Defined in ‘GHC.Base’ instance Functor ((,) a) -- Defined in ‘GHC.Base’ instance Monoid a => Monad ((,) a) -- Defined in ‘GHC.Base’ +instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‘GHC.Classes’ +instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’ +instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’ type (#,#) :: * -> * -> TYPE ===================================== testsuite/tests/ghci/scripts/ghci011.stdout ===================================== @@ -13,8 +13,8 @@ instance MonadFail [] -- Defined in ‘Control.Monad.Fail’ instance Monad [] -- Defined in ‘GHC.Base’ instance Eq a => Eq [a] -- Defined in ‘GHC.Classes’ instance Ord a => Ord [a] -- Defined in ‘GHC.Classes’ -type () :: * -data () = () +type Unit :: * +data Unit = () -- Defined in ‘GHC.Tuple.Prim’ instance Monoid () -- Defined in ‘GHC.Base’ instance Semigroup () -- Defined in ‘GHC.Base’ @@ -24,8 +24,8 @@ instance Enum () -- Defined in ‘GHC.Enum’ instance Ord () -- Defined in ‘GHC.Classes’ instance Show () -- Defined in ‘GHC.Show’ instance Eq () -- Defined in ‘GHC.Classes’ -type (,) :: * -> * -> * -data (,) a b = (,) a b +type Tuple2 :: * -> * -> * +data Tuple2 a b = (,) a b -- Defined in ‘GHC.Tuple.Prim’ instance Traversable ((,) a) -- Defined in ‘Data.Traversable’ instance (Monoid a, Monoid b) => Monoid (a, b) @@ -35,9 +35,9 @@ instance (Semigroup a, Semigroup b) => Semigroup (a, b) instance Foldable ((,) a) -- Defined in ‘Data.Foldable’ instance (Bounded a, Bounded b) => Bounded (a, b) -- Defined in ‘GHC.Enum’ +instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’ instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‘GHC.Classes’ instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’ -instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’ instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’ instance Monoid a => Applicative ((,) a) -- Defined in ‘GHC.Base’ instance Functor ((,) a) -- Defined in ‘GHC.Base’ ===================================== testsuite/tests/hiefile/should_run/HieQueries.stdout ===================================== @@ -46,7 +46,7 @@ At point (23,9), we found: | `- ┌ │ $dShow at HieQueries.hs:23:1-22, of type: Show (Integer, x, A) - │ is an evidence variable bound by a let, depending on: [$fShow(,,), + │ is an evidence variable bound by a let, depending on: [$fShowTuple3, │ $dShow, $dShow, $dShow] │ with scope: LocalScope HieQueries.hs:23:1-22 │ bound at: HieQueries.hs:23:1-22 @@ -54,7 +54,7 @@ At point (23,9), we found: └ | +- ┌ - | │ $fShow(,,) at HieQueries.hs:23:1-22, of type: forall a b c. (Show a, Show b, Show c) => Show (a, b, c) + | │ $fShowTuple3 at HieQueries.hs:23:1-22, of type: forall a b c. (Show a, Show b, Show c) => Show (a, b, c) | │ is a usage of an external evidence variable | │ Defined in `GHC.Show' | └ ===================================== testsuite/tests/module/TupleTyConUserSyntax.hs ===================================== @@ -0,0 +1,13 @@ +module TupleTyConUserSyntax where + +import TupleTyConUserSyntaxA + +type T1 = Tuple1 + +type T2 = Tuple2 + +type T23 = Tuple23 + +type T46 = Tuple46 + +type T64 = Tuple64 \ No newline at end of file ===================================== testsuite/tests/module/TupleTyConUserSyntaxA.hs ===================================== @@ -0,0 +1,11 @@ +module TupleTyConUserSyntaxA (module GHC.Tuple) where + +import GHC.Tuple + +type T1 = Tuple1 + +type T2 = Tuple2 + +type T23 = Tuple23 + +type T64 = Tuple64 \ No newline at end of file ===================================== testsuite/tests/module/all.T ===================================== @@ -295,3 +295,5 @@ test('T13704b', [], multimod_compile, ['T13704b1.hs T13704b2.hs', '-main-is T137 test('T20562', normal, compile, ['']) test('T21752', [extra_files(['T21752A.hs', 'T21752.hs'])], multimod_compile, ['T21752', '-v0']) + +test('TupleTyConUserSyntax', [extra_files(['TupleTyConUserSyntaxA.hs', 'TupleTyConUserSyntax.hs'])], multimod_compile, ['TupleTyConUserSyntax', '-v0']) ===================================== testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr ===================================== @@ -8,7 +8,7 @@ NamedWildcardsNotInMonotype.hs:5:1: error: [GHC-39999] The type variable ‘w0’ is ambiguous Potentially matching instances: instance Eq Ordering -- Defined in ‘GHC.Classes’ - instance Eq () -- Defined in ‘GHC.Classes’ + instance Eq a => Eq (Solo a) -- Defined in ‘GHC.Classes’ ...plus 22 others ...plus four instances involving out-of-scope types (use -fprint-potential-instances to see them all) ===================================== testsuite/tests/roles/should_compile/T8958.stderr ===================================== @@ -18,7 +18,7 @@ CLASS INSTANCES -- Defined at T8958.hs:11:10 instance [incoherent] Nominal a -- Defined at T8958.hs:8:10 Dependent modules: [] -Dependent packages: [base-4.17.0.0] +Dependent packages: [base-4.18.0.0] ==================== Typechecker ==================== T8958.$tcMap @@ -53,7 +53,7 @@ $krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* GHC.Types.krep$Constraint $krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp - GHC.Tuple.Prim.$tc(,) + GHC.Tuple.Prim.$tcTuple2 ((:) @GHC.Types.KindRep $krep ((:) @GHC.Types.KindRep $krep [] @GHC.Types.KindRep)) $krep [InlPrag=[~]] ===================================== testsuite/tests/stranal/sigs/T21119.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== -T21119.$fMyShow(,): <1!A> T21119.$fMyShowInt: <1!A> +T21119.$fMyShowTuple2: <1!A> T21119.get: <1!P(1!P(L),1!P(L))><1!P(L)><1L> T21119.getIO: <1P(1L,ML)><1L> T21119.indexError: <1C(1,L)><1!B>b @@ -10,8 +10,8 @@ T21119.throwIndexError: x ==================== Cpr signatures ==================== -T21119.$fMyShow(,): T21119.$fMyShowInt: +T21119.$fMyShowTuple2: T21119.get: T21119.getIO: 1 T21119.indexError: b @@ -20,8 +20,8 @@ T21119.throwIndexError: b ==================== Strictness signatures ==================== -T21119.$fMyShow(,): <1!A> T21119.$fMyShowInt: <1!A> +T21119.$fMyShowTuple2: <1!A> T21119.get: <1!P(1!P(L),1!P(L))><1!P(L)><1L> T21119.getIO: <1P(1L,ML)><1L> T21119.indexError: <1C(1,L)><1!B>b ===================================== testsuite/tests/stranal/sigs/T21888.stderr ===================================== @@ -1,30 +1,30 @@ ==================== Strictness signatures ==================== -Data.MemoTrie.$fHasTrie(): -Data.MemoTrie.$fHasTrie(,): <1C(1,L)> Data.MemoTrie.$fHasTrieBool: <1!P(L,L)> Data.MemoTrie.$fHasTrieEither: <1C(1,L)><1C(1,L)><1!P(L,L)> Data.MemoTrie.$fHasTrieInteger: <1!P(1!P(S,1!P(1!P(S,1L),1!P(S,1L))),1!P(S,1!P(1!P(S,1L),1!P(S,1L))))>b Data.MemoTrie.$fHasTrieList: <1!P(L,L)> +Data.MemoTrie.$fHasTrieTuple2: <1C(1,L)> +Data.MemoTrie.$fHasTrieUnit: ==================== Cpr signatures ==================== -Data.MemoTrie.$fHasTrie(): -Data.MemoTrie.$fHasTrie(,): Data.MemoTrie.$fHasTrieBool: Data.MemoTrie.$fHasTrieEither: Data.MemoTrie.$fHasTrieInteger: Data.MemoTrie.$fHasTrieList: +Data.MemoTrie.$fHasTrieTuple2: +Data.MemoTrie.$fHasTrieUnit: ==================== Strictness signatures ==================== -Data.MemoTrie.$fHasTrie(): -Data.MemoTrie.$fHasTrie(,): <1C(1,L)> Data.MemoTrie.$fHasTrieBool: <1!P(L,L)> Data.MemoTrie.$fHasTrieEither: <1C(1,L)><1C(1,L)><1!P(L,L)> Data.MemoTrie.$fHasTrieInteger: <1!P(1!P(B,1!P(1!P(B,1!P(L,L)),1!P(B,1!P(L,L)))),1!P(B,1!P(1!B,1!B)))>b Data.MemoTrie.$fHasTrieList: <1!P(L,L)> +Data.MemoTrie.$fHasTrieTuple2: <1C(1,L)> +Data.MemoTrie.$fHasTrieUnit: ===================================== testsuite/tests/th/T12478_4.stderr ===================================== @@ -2,5 +2,5 @@ T12478_4.hs:7:7: error: [GHC-97721] • Illegal sum arity: 1 Sums must have an arity of at least 2 - When splicing a TH type: (# #) GHC.Tuple.Prim.() + When splicing a TH type: (# #) GHC.Tuple.Prim.Unit • In the untyped splice: $(unboxedSumT 1 `appT` conT ''()) ===================================== testsuite/tests/typecheck/should_compile/T18529.stderr ===================================== @@ -6,7 +6,7 @@ TYPE CONSTRUCTORS COERCION AXIOMS axiom Bug.N:C :: forall a b. C a b = a -> b -> () Dependent modules: [] -Dependent packages: [base-4.17.0.0] +Dependent packages: [base-4.18.0.0] ==================== Typechecker ==================== Bug.$tcC @@ -32,7 +32,7 @@ $krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* GHC.Types.krep$Constraint $krep [InlPrag=[~]] = GHC.Types.KindRepTyConApp - GHC.Tuple.Prim.$tc() [] @GHC.Types.KindRep + GHC.Tuple.Prim.$tcUnit [] @GHC.Types.KindRep Bug.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Bug"#) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 519a95998b09a2c9c7a42c3a0cf2ca0c4358bb49 +Subproject commit 1f22a95c1db942fce2623b9daa26f66d193a4e7f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a13affce1a6196ccff6c126112ab26823c85e727 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a13affce1a6196ccff6c126112ab26823c85e727 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 15:18:13 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 21 Mar 2023 11:18:13 -0400 Subject: [Git][ghc/ghc][master] 5 commits: docs: fix some wrongs in the eventlog format documentation Message-ID: <6419cab5128cb_90da1b1f0f5c298480@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - 1 changed file: - docs/users_guide/eventlog-formats.rst Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -44,7 +44,9 @@ start with the event type id and a 64-bit timestamp: EventLog : EVENT_HEADER_BEGIN + EVENT_HET_BEGIN -- header event types begin EventType* + EVENT_HET_END -- header event types end EVENT_HEADER_END EVENT_DATA_BEGIN Event* @@ -120,6 +122,18 @@ environment which the program is being run in. Describes the environment variables present in the program's environment. +.. event-type:: WALL_CLOCK_TIME + + :tag: 43 + :length: fixed + :field CapSetId: Capability set + :field Word64: Unix epoch seconds + :field Word32: Nanoseconds + + Records the wall clock time to make it possible to correlate events from + elsewhere with the eventlog. + + Thread and scheduling events ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -162,6 +176,7 @@ Thread and scheduling events * 12: BlockedOnSTM * 13: BlockedOnDoProc * 16: BlockedOnMsgThrowTo + * 20: BlockedOnMVarRead :field ThreadId: thread id of thread being blocked on (only for some status values) @@ -200,7 +215,7 @@ Thread and scheduling events .. event-type:: THREAD_LABEL :tag: 44 - :length: fixed + :length: variable :field ThreadId: thread id :field String: label @@ -332,9 +347,10 @@ in :ref:`nonmoving-gc-events`. :field Word64: bytes of fragmentation, the difference between total mblock size and total block size. When all mblocks are full of full blocks, this number is 0. - :field Word64: number of parallel garbage collection threads + :field Word32: number of parallel garbage collection threads :field Word64: maximum number of bytes copied by any single collector thread :field Word64: total bytes copied by all collector threads + :field Word64: the amount of balanced data copied by all threads Report various information about a major collection. @@ -535,6 +551,15 @@ Task events Marks the migration of a task to a new capability. +.. event-type:: TASK_DELETE + + :tag: 57 + :length: fixed + :field TaskId: task id + + Marks the deletion of a task. + + Tracing events ~~~~~~~~~~~~~~ @@ -549,12 +574,13 @@ Tracing events .. event-type:: BLOCK_MARKER :tag: 18 - :length: variable - :field Word32: size + :length: fixed + :field Word32: block size :field Word64: end time in nanoseconds - :field String: marker name + :field Word16: capability number, invalid if ``0xffff``. - TODO + Marks a chunk of events. The events that fit in the next ``block size`` + bytes all belong to the block marker capability. .. event-type:: USER_MSG View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a13affce1a6196ccff6c126112ab26823c85e727...bb05b4ccdfe81e9fc60065337eafa9c94499ad61 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a13affce1a6196ccff6c126112ab26823c85e727...bb05b4ccdfe81e9fc60065337eafa9c94499ad61 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 15:19:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 21 Mar 2023 11:19:02 -0400 Subject: [Git][ghc/ghc][master] Add structured error messages for GHC.Tc.Utils.Env Message-ID: <6419cae6e4a3c_90da1b4f1aa830538c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 29 changed files: - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types.hs-boot - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/annotations/should_fail/annfail03.stderr - testsuite/tests/annotations/should_fail/annfail04.stderr - testsuite/tests/annotations/should_fail/annfail06.stderr - testsuite/tests/annotations/should_fail/annfail09.stderr - testsuite/tests/quasiquotation/qq001/qq001.stderr - testsuite/tests/quasiquotation/qq002/qq002.stderr - testsuite/tests/quasiquotation/qq003/qq003.stderr - testsuite/tests/quasiquotation/qq004/qq004.stderr - testsuite/tests/th/T17820a.stderr - testsuite/tests/th/T17820b.stderr - testsuite/tests/th/T17820c.stderr - testsuite/tests/th/T17820d.stderr - testsuite/tests/th/T17820e.stderr - testsuite/tests/th/T21547.stderr - testsuite/tests/th/T5795.stderr Changes: ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -7,7 +7,7 @@ The bits common to GHC.Tc.TyCl.Instance and GHC.Tc.Deriv. -} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} module GHC.Core.InstEnv ( DFunId, InstMatch, ClsInstLookupResult, @@ -19,6 +19,7 @@ module GHC.Core.InstEnv ( fuzzyClsInstCmp, orphNamesOfClsInst, InstEnvs(..), VisibleOrphanModules, InstEnv, + LookupInstanceErrReason (..), mkInstEnv, emptyInstEnv, unionInstEnv, extendInstEnv, filterInstEnv, deleteFromInstEnv, deleteDFunFromInstEnv, anyInstEnv, @@ -51,6 +52,7 @@ import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Basic import GHC.Types.Id +import GHC.Generics (Generic) import Data.Data ( Data ) import Data.List.NonEmpty ( NonEmpty (..), nonEmpty ) import qualified Data.List.NonEmpty as NE @@ -928,18 +930,28 @@ anyone noticing, so it's manifestly not ruining anyone's day.) -- yield 'Left errorMessage'. lookupUniqueInstEnv :: InstEnvs -> Class -> [Type] - -> Either SDoc (ClsInst, [Type]) + -> Either LookupInstanceErrReason (ClsInst, [Type]) lookupUniqueInstEnv instEnv cls tys = case lookupInstEnv False instEnv cls tys of ([(inst, inst_tys)], _, _) | noFlexiVar -> Right (inst, inst_tys') - | otherwise -> Left $ text "flexible type variable:" <+> - (ppr $ mkTyConApp (classTyCon cls) tys) + | otherwise -> Left $ LookupInstErrFlexiVar where inst_tys' = [ty | Just ty <- inst_tys] noFlexiVar = all isJust inst_tys - _other -> Left $ text "instance not found" <+> - (ppr $ mkTyConApp (classTyCon cls) tys) + _other -> Left $ LookupInstErrNotFound + +-- | Why a particular typeclass application couldn't be looked up. +data LookupInstanceErrReason = + -- | Tyvars aren't an exact match. + LookupInstErrNotExact + | + -- | One of the tyvars is flexible. + LookupInstErrFlexiVar + | + -- | No matching instance was found. + LookupInstErrNotFound + deriving (Generic) data Coherence = IsCoherent | IsIncoherent ===================================== compiler/GHC/Rename/Splice.hs ===================================== @@ -915,7 +915,7 @@ checkThLocalName name Nothing -> return () ; -- Not a locally-bound thing Just (top_lvl, bind_lvl, use_stage) -> do { let use_lvl = thLevel use_stage - ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl + ; checkWellStaged (StageCheckSplice name) bind_lvl use_lvl ; traceRn "checkThLocalName" (ppr name <+> ppr bind_lvl <+> ppr use_stage <+> ppr use_lvl) ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -43,7 +43,7 @@ import GHC.Core.Type import GHC.Hs import GHC.Types.Name.Reader import GHC.Tc.Errors.Types -import GHC.Tc.Utils.Env +-- import GHC.Tc.Utils.Env import GHC.Tc.Utils.Monad import GHC.Types.Error import GHC.Types.Name ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -20,6 +20,7 @@ module GHC.Tc.Errors.Ppr , pprHsDocContext , inHsDocContext , TcRnMessageOpts(..) + , pprTyThingUsedWrong ) where @@ -51,7 +52,7 @@ import GHC.Hs import GHC.Tc.Errors.Types import GHC.Tc.Types.Constraint -import {-# SOURCE #-} GHC.Tc.Types( getLclEnvLoc, lclEnvInGeneratedCode ) +import {-# SOURCE #-} GHC.Tc.Types( getLclEnvLoc, lclEnvInGeneratedCode, TcTyThing ) import GHC.Tc.Types.Origin import GHC.Tc.Types.Rank (Rank(..)) import GHC.Tc.Utils.TcType @@ -100,6 +101,7 @@ import Data.Ord ( comparing ) import Data.Bifunctor import GHC.Types.Name.Env import qualified Language.Haskell.TH as TH +import {-# SOURCE #-} GHC.Tc.Types (pprTcTyThingCategory) data TcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext :: !Bool -- ^ Whether we show the error context or not } @@ -665,6 +667,10 @@ instance Diagnostic TcRnMessage where TcRnCannotDeriveInstance cls cls_tys mb_strat newtype_deriving reason -> mkSimpleDecorated $ derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving True reason + TcRnLookupInstance cls tys reason + -> mkSimpleDecorated $ + text "Couldn't match instance:" <+> + lookupInstanceErrDiagnosticMessage cls tys reason TcRnLazyGADTPattern -> mkSimpleDecorated $ hang (text "An existential or GADT data constructor cannot be used") @@ -1433,6 +1439,20 @@ instance Diagnostic TcRnMessage where hsep [ text "Unknown type variable" <> plural errorVars , text "on the RHS of injectivity condition:" , interpp'SP errorVars ] + TcRnBadlyStaged reason bind_lvl use_lvl + -> mkSimpleDecorated $ + text "Stage error:" <+> pprStageCheckReason reason <+> + hsep [text "is bound at stage" <+> ppr bind_lvl, + text "but used at stage" <+> ppr use_lvl] + TcRnStageRestriction reason + -> mkSimpleDecorated $ + sep [ text "GHC stage restriction:" + , nest 2 (vcat [ pprStageCheckReason reason <+> + text "is used in a top-level splice, quasi-quote, or annotation," + , text "and must be imported, not defined locally"])] + TcRnTyThingUsedWrong sort thing name + -> mkSimpleDecorated $ + pprTyThingUsedWrong sort thing name diagnosticReason = \case TcRnUnknownMessage m @@ -1655,6 +1675,8 @@ instance Diagnostic TcRnMessage where DerivErrBadConstructor{} -> ErrorWithoutFlag DerivErrGenerics{} -> ErrorWithoutFlag DerivErrEnumOrProduct{} -> ErrorWithoutFlag + TcRnLookupInstance _ _ _ + -> ErrorWithoutFlag TcRnLazyGADTPattern -> ErrorWithoutFlag TcRnArrowProcGADTPattern @@ -1903,6 +1925,12 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnUnknownTyVarsOnRhsOfInjCond{} -> ErrorWithoutFlag + TcRnBadlyStaged{} + -> ErrorWithoutFlag + TcRnStageRestriction{} + -> ErrorWithoutFlag + TcRnTyThingUsedWrong{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2123,6 +2151,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnCannotDeriveInstance cls _ _ newtype_deriving rea -> deriveInstanceErrReasonHints cls newtype_deriving rea + TcRnLookupInstance _ _ _ + -> noHints TcRnLazyGADTPattern -> noHints TcRnArrowProcGADTPattern @@ -2391,6 +2421,12 @@ instance Diagnostic TcRnMessage where -> noHints TcRnUnknownTyVarsOnRhsOfInjCond{} -> noHints + TcRnBadlyStaged{} + -> noHints + TcRnStageRestriction{} + -> noHints + TcRnTyThingUsedWrong{} + -> noHints diagnosticCode = constructorCode @@ -2770,6 +2806,18 @@ derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving pprHerald = \cas in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald (ppr1 $$ text " or" $$ ppr2) +lookupInstanceErrDiagnosticMessage :: Class + -> [Type] + -> LookupInstanceErrReason + -> SDoc +lookupInstanceErrDiagnosticMessage cls tys = \case + LookupInstErrNotExact + -> text "Not an exact match (i.e., some variables get instantiated)" + LookupInstErrFlexiVar + -> text "flexible type variable:" <+> (ppr $ mkTyConApp (classTyCon cls) tys) + LookupInstErrNotFound + -> text "instance not found" <+> (ppr $ mkTyConApp (classTyCon cls) tys) + {- ********************************************************************* * * Outputable SolverReportErrCtxt (for debugging) @@ -3833,6 +3881,10 @@ pprScopeError rdr_name scope_err = 2 (what <+> quotes (ppr rdr_name) <+> text "in this module") UnknownSubordinate doc -> quotes (ppr rdr_name) <+> text "is not a (visible)" <+> doc + NotInScopeTc env -> + vcat[text "GHC internal error:" <+> quotes (ppr rdr_name) <+> + text "is not in scope during type checking, but it passed the renamer", + text "tcl_env of environment:" <+> ppr env] where what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name)) @@ -3845,6 +3897,7 @@ scopeErrorHints scope_err = MissingBinding _ hints -> hints NoTopLevelBinding -> noHints UnknownSubordinate {} -> noHints + NotInScopeTc _ -> noHints {- ********************************************************************* * * @@ -4429,3 +4482,26 @@ pprConversionFailReason = \case text "Function binding for" <+> quotes (text (TH.pprint nm)) <+> text "has no equations" + +pprTyThingUsedWrong :: WrongThingSort -> TcTyThing -> Name -> SDoc +pprTyThingUsedWrong sort thing name = + pprTcTyThingCategory thing <+> quotes (ppr name) <+> + text "used as a" <+> pprWrongThingSort sort + +pprWrongThingSort :: WrongThingSort -> SDoc +pprWrongThingSort = + text . \case + WrongThingType -> "type" + WrongThingDataCon -> "data constructor" + WrongThingPatSyn -> "pattern synonym" + WrongThingConLike -> "constructor-like thing" + WrongThingClass -> "class" + WrongThingTyCon -> "type constructor" + WrongThingAxiom -> "axiom" + +pprStageCheckReason :: StageCheckReason -> SDoc +pprStageCheckReason = \case + StageCheckInstance _ t -> + text "instance for" <+> quotes (ppr t) + StageCheckSplice t -> + quotes (ppr t) ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -92,6 +92,8 @@ module GHC.Tc.Errors.Types ( , NonStandardGuards(..) , RuleLhsErrReason(..) , HsigShapeMismatchReason(..) + , WrongThingSort(..) + , StageCheckReason(..) ) where import GHC.Prelude @@ -103,7 +105,7 @@ import GHC.Tc.Types.Constraint import GHC.Tc.Types.Evidence (EvBindsVar) import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , UserTypeCtxt (PatSynCtxt), TyVarBndrs, TypedThing - , FixedRuntimeRepOrigin(..) ) + , FixedRuntimeRepOrigin(..), InstanceWhat ) import GHC.Tc.Types.Rank (Rank) import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType) import GHC.Types.Avail (AvailInfo) @@ -125,7 +127,7 @@ import GHC.Core.Coercion.Axiom (CoAxBranch) import GHC.Core.ConLike (ConLike) import GHC.Core.DataCon (DataCon) import GHC.Core.FamInstEnv (FamInst) -import GHC.Core.InstEnv (ClsInst) +import GHC.Core.InstEnv (LookupInstanceErrReason, ClsInst) import GHC.Core.PatSyn (PatSyn) import GHC.Core.Predicate (EqRel, predTypeEqRel) import GHC.Core.TyCon (TyCon, TyConFlavour) @@ -146,6 +148,7 @@ import GHC.Unit.Module.Warnings (WarningTxt) import qualified Language.Haskell.TH.Syntax as TH import GHC.Generics ( Generic ) +import GHC.Types.Name.Env (NameEnv) {- Note [Migrating TcM Messages] @@ -3209,6 +3212,51 @@ data TcRnMessage where -} TcRnUnknownTyVarsOnRhsOfInjCond :: [Name] -> TcRnMessage + {-| TcRnLookupInstance groups several errors emitted when looking up class instances. + + Test cases: + none + -} + TcRnLookupInstance + :: !Class + -> ![Type] + -> !LookupInstanceErrReason + -> TcRnMessage + + {-| TcRnBadlyStaged is an error that occurs when a TH binding is used in an + invalid stage. + + Test cases: + T17820d + -} + TcRnBadlyStaged + :: !StageCheckReason -- ^ The binding being spliced. + -> !Int -- ^ The binding stage. + -> !Int -- ^ The stage at which the binding is used. + -> TcRnMessage + + {-| TcRnStageRestriction is an error that occurs when a top level splice refers to + a local name. + + Test cases: + T17820, T21547, T5795, qq00[1-4], annfail0{3,4,6,9} + -} + TcRnStageRestriction + :: !StageCheckReason -- ^ The binding being spliced. + -> TcRnMessage + + {-| TcRnTyThingUsedWrong is an error that occurs when a thing is used where another + thing was expected. + + Test cases: + none + -} + TcRnTyThingUsedWrong + :: !WrongThingSort -- ^ Expected thing. + -> !TcTyThing -- ^ Thing used wrongly. + -> !Name -- ^ Name of the thing used wrongly. + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -4173,6 +4221,12 @@ data NotInScopeError -- or, a class doesn't have an associated type with this name, -- or, a record doesn't have a record field with this name. | UnknownSubordinate SDoc + + -- | A name is not in scope during type checking but passed the renamer. + -- + -- Test cases: + -- none + | NotInScopeTc (NameEnv TcTyThing) deriving Generic -- | Create a @"not in scope"@ error message for the given 'RdrName'. @@ -4471,3 +4525,16 @@ data HsigShapeMismatchReason = -} HsigShapeNotUnifiable !Name !Name !Bool deriving (Generic) + +data WrongThingSort + = WrongThingType + | WrongThingDataCon + | WrongThingPatSyn + | WrongThingConLike + | WrongThingClass + | WrongThingTyCon + | WrongThingAxiom + +data StageCheckReason + = StageCheckInstance !InstanceWhat !PredType + | StageCheckSplice !Name ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1994,7 +1994,7 @@ tcTyVar name -- Could be a tyvar, a tycon, or a datacon APromotionErr err -> promotionErr name err - _ -> wrongThingErr "type" thing name } + _ -> wrongThingErr WrongThingType thing name } {- Note [Recursion through the kinds] ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -4,7 +4,7 @@ module GHC.Tc.Instance.Class ( matchGlobalInst, ClsInstResult(..), - InstanceWhat(..), safeOverlap, instanceReturnsDictCon, + safeOverlap, instanceReturnsDictCon, AssocInstInfo(..), isNotAssociated, ) where @@ -21,6 +21,7 @@ import GHC.Tc.Utils.Instantiate(instDFunType, tcInstType) import GHC.Tc.Instance.Typeable import GHC.Tc.Utils.TcMType import GHC.Tc.Types.Evidence +import GHC.Tc.Types.Origin (InstanceWhat (..), SafeOverlapping) import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst ) import GHC.Rename.Env( addUsedGRE ) @@ -31,7 +32,7 @@ import GHC.Builtin.Names import GHC.Types.FieldLabel import GHC.Types.Name.Reader( lookupGRE_FieldLabel, greMangledName ) import GHC.Types.SafeHaskell -import GHC.Types.Name ( Name, pprDefinedAt ) +import GHC.Types.Name ( Name ) import GHC.Types.Var.Env ( VarEnv ) import GHC.Types.Id import GHC.Types.Var @@ -86,13 +87,6 @@ isNotAssociated (InClsInst {}) = False * * **********************************************************************-} --- | Indicates if Instance met the Safe Haskell overlapping instances safety --- check. --- --- See Note [Safe Haskell Overlapping Instances] in GHC.Tc.Solver --- See Note [Safe Haskell Overlapping Instances Implementation] in GHC.Tc.Solver -type SafeOverlapping = Bool - data ClsInstResult = NoInstance -- Definitely no instance @@ -103,23 +97,6 @@ data ClsInstResult | NotSure -- Multiple matches and/or one or more unifiers -data InstanceWhat -- How did we solve this constraint? - = BuiltinEqInstance -- Built-in solver for (t1 ~ t2), (t1 ~~ t2), Coercible t1 t2 - -- See GHC.Tc.Solver.InertSet Note [Solved dictionaries] - - | BuiltinTypeableInstance TyCon -- Built-in solver for Typeable (T t1 .. tn) - -- See Note [Well-staged instance evidence] - - | BuiltinInstance -- Built-in solver for (C t1 .. tn) where C is - -- KnownNat, .. etc (classes with no top-level evidence) - - | LocalInstance -- Solved by a quantified constraint - -- See GHC.Tc.Solver.InertSet Note [Solved dictionaries] - - | TopLevInstance -- Solved by a top-level instance decl - { iw_dfun_id :: DFunId - , iw_safe_over :: SafeOverlapping } - instance Outputable ClsInstResult where ppr NoInstance = text "NoInstance" ppr NotSure = text "NotSure" @@ -127,15 +104,6 @@ instance Outputable ClsInstResult where , cir_what = what }) = text "OneInst" <+> vcat [ppr ev, ppr what] -instance Outputable InstanceWhat where - ppr BuiltinInstance = text "a built-in instance" - ppr BuiltinTypeableInstance {} = text "a built-in typeable instance" - ppr BuiltinEqInstance = text "a built-in equality instance" - ppr LocalInstance = text "a locally-quantified instance" - ppr (TopLevInstance { iw_dfun_id = dfun }) - = hang (text "instance" <+> pprSigmaType (idType dfun)) - 2 (text "--" <+> pprDefinedAt (idName dfun)) - safeOverlap :: InstanceWhat -> Bool safeOverlap (TopLevInstance { iw_safe_over = so }) = so safeOverlap _ = True ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -16,7 +16,7 @@ import GHC.Tc.Utils.TcType import GHC.Builtin.Names ( coercibleTyConKey, heqTyConKey, eqTyConKey, ipClassKey ) import GHC.Tc.Instance.FunDeps import GHC.Tc.Instance.Family -import GHC.Tc.Instance.Class ( InstanceWhat(..), safeOverlap ) +import GHC.Tc.Instance.Class ( safeOverlap ) import GHC.Tc.Types.Evidence import GHC.Utils.Outputable ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -134,7 +134,7 @@ import qualified GHC.Tc.Utils.Env as TcM import GHC.Driver.Session -import GHC.Tc.Instance.Class( InstanceWhat(..), safeOverlap, instanceReturnsDictCon ) +import GHC.Tc.Instance.Class( safeOverlap, instanceReturnsDictCon ) import GHC.Tc.Utils.TcType import GHC.Tc.Solver.Types import GHC.Tc.Solver.InertSet @@ -1420,11 +1420,9 @@ checkWellStagedDFun loc what pred Just bind_lvl | bind_lvl > impLevel -> wrapTcS $ TcM.setCtLocM loc $ do { use_stage <- TcM.getStage - ; TcM.checkWellStaged pp_thing bind_lvl (thLevel use_stage) } + ; TcM.checkWellStaged (StageCheckInstance what pred) bind_lvl (thLevel use_stage) } _ -> return () - where - pp_thing = text "instance for" <+> quotes (ppr pred) -- | Returns the ThLevel of evidence for the solved constraint (if it has evidence) -- See Note [Well-staged instance evidence] ===================================== compiler/GHC/Tc/Types.hs-boot ===================================== @@ -22,3 +22,4 @@ setLclEnvLoc :: TcLclEnv -> RealSrcSpan -> TcLclEnv getLclEnvLoc :: TcLclEnv -> RealSrcSpan lclEnvInGeneratedCode :: TcLclEnv -> Bool +pprTcTyThingCategory :: TcTyThing -> SDoc ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -35,6 +35,8 @@ module GHC.Tc.Types.Origin ( FRRArrowContext(..), pprFRRArrowContext, ExpectedFunTyOrigin(..), pprExpectedFunTyOrigin, pprExpectedFunTyHerald, + -- InstanceWhat + InstanceWhat(..), SafeOverlapping ) where import GHC.Prelude @@ -1401,3 +1403,42 @@ pprExpectedFunTyHerald (ExpectedFunTyLam match) pprExpectedFunTyHerald (ExpectedFunTyLamCase _ expr) = sep [ text "The function" <+> quotes (ppr expr) , text "requires" ] + +{- ******************************************************************* +* * + InstanceWhat +* * +**********************************************************************-} + +-- | Indicates if Instance met the Safe Haskell overlapping instances safety +-- check. +-- +-- See Note [Safe Haskell Overlapping Instances] in GHC.Tc.Solver +-- See Note [Safe Haskell Overlapping Instances Implementation] in GHC.Tc.Solver +type SafeOverlapping = Bool + +data InstanceWhat -- How did we solve this constraint? + = BuiltinEqInstance -- Built-in solver for (t1 ~ t2), (t1 ~~ t2), Coercible t1 t2 + -- See GHC.Tc.Solver.InertSet Note [Solved dictionaries] + + | BuiltinTypeableInstance TyCon -- Built-in solver for Typeable (T t1 .. tn) + -- See Note [Well-staged instance evidence] + + | BuiltinInstance -- Built-in solver for (C t1 .. tn) where C is + -- KnownNat, .. etc (classes with no top-level evidence) + + | LocalInstance -- Solved by a quantified constraint + -- See GHC.Tc.Solver.InertSet Note [Solved dictionaries] + + | TopLevInstance -- Solved by a top-level instance decl + { iw_dfun_id :: DFunId + , iw_safe_over :: SafeOverlapping } + +instance Outputable InstanceWhat where + ppr BuiltinInstance = text "a built-in instance" + ppr BuiltinTypeableInstance {} = text "a built-in typeable instance" + ppr BuiltinEqInstance = text "a built-in equality instance" + ppr LocalInstance = text "a locally-quantified instance" + ppr (TopLevInstance { iw_dfun_id = dfun }) + = hang (text "instance" <+> pprSigmaType (idType dfun)) + 2 (text "--" <+> pprDefinedAt (idName dfun)) ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -60,6 +60,7 @@ module GHC.Tc.Utils.Env( tcGetDefaultTys, -- Template Haskell stuff + StageCheckReason(..), checkWellStaged, tcMetaTy, thLevel, topIdLvl, isBrackStage, @@ -67,7 +68,7 @@ module GHC.Tc.Utils.Env( newDFunName, newFamInstTyConName, newFamInstAxiomName, mkStableIdFromString, mkStableIdFromName, - mkWrapperName + mkWrapperName, ) where import GHC.Prelude @@ -129,8 +130,8 @@ import GHC.Types.Var import GHC.Types.Var.Env import GHC.Types.Name.Reader import GHC.Types.TyThing -import GHC.Types.Error import qualified GHC.LanguageExtensions as LangExt +import GHC.Tc.Errors.Ppr (pprTyThingUsedWrong) import Data.IORef import Data.List (intercalate) @@ -192,21 +193,22 @@ importDecl_maybe hsc_env name | otherwise = initIfaceLoad hsc_env (importDecl name) +-- | A 'TyThing'... except it's not the right sort. +type WrongTyThing = TyThing + ioLookupDataCon :: HscEnv -> Name -> IO DataCon ioLookupDataCon hsc_env name = do mb_thing <- ioLookupDataCon_maybe hsc_env name case mb_thing of Succeeded thing -> return thing - Failed msg -> pprPanic "lookupDataConIO" msg + Failed thing -> pprPanic "lookupDataConIO" (pprTyThingUsedWrong WrongThingDataCon (AGlobal thing) name) -ioLookupDataCon_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc DataCon) +ioLookupDataCon_maybe :: HscEnv -> Name -> IO (MaybeErr WrongTyThing DataCon) ioLookupDataCon_maybe hsc_env name = do thing <- lookupGlobal hsc_env name return $ case thing of AConLike (RealDataCon con) -> Succeeded con - _ -> Failed $ - pprTcTyThingCategory (AGlobal thing) <+> quotes (ppr name) <+> - text "used as a data constructor" + _ -> Failed thing addTypecheckedBinds :: TcGblEnv -> [LHsBinds GhcTc] -> TcGblEnv addTypecheckedBinds tcg_env binds @@ -274,42 +276,42 @@ tcLookupDataCon name = do thing <- tcLookupGlobal name case thing of AConLike (RealDataCon con) -> return con - _ -> wrongThingErr "data constructor" (AGlobal thing) name + _ -> wrongThingErr WrongThingDataCon (AGlobal thing) name tcLookupPatSyn :: Name -> TcM PatSyn tcLookupPatSyn name = do thing <- tcLookupGlobal name case thing of AConLike (PatSynCon ps) -> return ps - _ -> wrongThingErr "pattern synonym" (AGlobal thing) name + _ -> wrongThingErr WrongThingPatSyn (AGlobal thing) name tcLookupConLike :: Name -> TcM ConLike tcLookupConLike name = do thing <- tcLookupGlobal name case thing of AConLike cl -> return cl - _ -> wrongThingErr "constructor-like thing" (AGlobal thing) name + _ -> wrongThingErr WrongThingConLike (AGlobal thing) name tcLookupClass :: Name -> TcM Class tcLookupClass name = do thing <- tcLookupGlobal name case thing of ATyCon tc | Just cls <- tyConClass_maybe tc -> return cls - _ -> wrongThingErr "class" (AGlobal thing) name + _ -> wrongThingErr WrongThingClass (AGlobal thing) name tcLookupTyCon :: Name -> TcM TyCon tcLookupTyCon name = do thing <- tcLookupGlobal name case thing of ATyCon tc -> return tc - _ -> wrongThingErr "type constructor" (AGlobal thing) name + _ -> wrongThingErr WrongThingTyCon (AGlobal thing) name tcLookupAxiom :: Name -> TcM (CoAxiom Branched) tcLookupAxiom name = do thing <- tcLookupGlobal name case thing of ACoAxiom ax -> return ax - _ -> wrongThingErr "axiom" (AGlobal thing) name + _ -> wrongThingErr WrongThingAxiom (AGlobal thing) name tcLookupLocatedGlobalId :: LocatedA Name -> TcM Id tcLookupLocatedGlobalId = addLocMA tcLookupId @@ -326,17 +328,13 @@ tcLookupLocatedTyCon = addLocMA tcLookupTyCon tcLookupInstance :: Class -> [Type] -> TcM ClsInst tcLookupInstance cls tys = do { instEnv <- tcGetInstEnvs - ; case lookupUniqueInstEnv instEnv cls tys of - Left err -> - failWithTc $ mkTcRnUnknownMessage - $ mkPlainError noHints (text "Couldn't match instance:" <+> err) - Right (inst, tys) - | uniqueTyVars tys -> return inst - | otherwise -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints errNotExact) + ; let inst = lookupUniqueInstEnv instEnv cls tys >>= \ (inst, tys) -> + if uniqueTyVars tys then Right inst else Left LookupInstErrNotExact + ; case inst of + Right i -> return i + Left err -> failWithTc (TcRnLookupInstance cls tys err) } where - errNotExact = text "Not an exact match (i.e., some variables get instantiated)" - uniqueTyVars tys = all isTyVarTy tys && hasNoDups (map getTyVar tys) @@ -886,7 +884,7 @@ tcExtendRules lcl_rules thing_inside ************************************************************************ -} -checkWellStaged :: SDoc -- What the stage check is for +checkWellStaged :: StageCheckReason -- What the stage check is for -> ThLevel -- Binding level (increases inside brackets) -> ThLevel -- Use stage -> TcM () -- Fail if badly staged, adding an error @@ -895,22 +893,11 @@ checkWellStaged pp_thing bind_lvl use_lvl = return () -- E.g. \x -> [| $(f x) |] | bind_lvl == outerLevel -- GHC restriction on top level splices - = stageRestrictionError pp_thing + = failWithTc (TcRnStageRestriction pp_thing) | otherwise -- Badly staged = failWithTc $ -- E.g. \x -> $(f x) - mkTcRnUnknownMessage $ mkPlainError noHints $ - text "Stage error:" <+> pp_thing <+> - hsep [text "is bound at stage" <+> ppr bind_lvl, - text "but used at stage" <+> ppr use_lvl] - -stageRestrictionError :: SDoc -> TcM a -stageRestrictionError pp_thing - = failWithTc $ - mkTcRnUnknownMessage $ mkPlainError noHints $ - sep [ text "GHC stage restriction:" - , nest 2 (vcat [ pp_thing <+> text "is used in a top-level splice, quasi-quote, or annotation," - , text "and must be imported, not defined locally"])] + TcRnBadlyStaged pp_thing bind_lvl use_lvl topIdLvl :: Id -> ThLevel -- Globals may either be imported, or may be from an earlier "chunk" @@ -1173,12 +1160,9 @@ notFound name Splice {} | isUnboundName name -> failM -- If the name really isn't in scope -- don't report it again (#11941) - | otherwise -> stageRestrictionError (quotes (ppr name)) + | otherwise -> failWithTc (TcRnStageRestriction (StageCheckSplice name)) _ -> failWithTc $ - mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat[text "GHC internal error:" <+> quotes (ppr name) <+> - text "is not in scope during type checking, but it passed the renamer", - text "tcl_env of environment:" <+> ppr (tcl_env lcl_env)] + mkTcRnNotInScope (getRdrName name) (NotInScopeTc (tcl_env lcl_env)) -- Take care: printing the whole gbl env can -- cause an infinite loop, in the case where we -- are in the middle of a recursive TyCon/Class group; @@ -1186,12 +1170,9 @@ notFound name -- very unhelpful, because it hides one compiler bug with another } -wrongThingErr :: String -> TcTyThing -> Name -> TcM a -wrongThingErr expected thing name - = let msg = mkTcRnUnknownMessage $ mkPlainError noHints $ - (pprTcTyThingCategory thing <+> quotes (ppr name) <+> - text "used as a" <+> text expected) - in failWithTc msg +wrongThingErr :: WrongThingSort -> TcTyThing -> Name -> TcM a +wrongThingErr expected thing name = + failWithTc (TcRnTyThingUsedWrong expected thing name) {- Note [Out of scope might be a staging error] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Data.Maybe -- friends: import GHC.Tc.Utils.Unify ( tcSubTypeAmbiguity ) import GHC.Tc.Solver ( simplifyAmbiguityCheck ) -import GHC.Tc.Instance.Class ( matchGlobalInst, ClsInstResult(..), InstanceWhat(..), AssocInstInfo(..) ) +import GHC.Tc.Instance.Class ( matchGlobalInst, ClsInstResult(..), AssocInstInfo(..) ) import GHC.Tc.Utils.TcType import GHC.Tc.Types.Origin import GHC.Tc.Types.Rank ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Exts ( proxy# ) import GHC.Generics import GHC.TypeLits ( Symbol, TypeError, ErrorMessage(..) ) import GHC.TypeNats ( Nat, KnownNat, natVal' ) +import GHC.Core.InstEnv (LookupInstanceErrReason) {- Note [Diagnostic codes] ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -535,6 +536,9 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnShadowedTyVarNameInFamResult" = 99412 GhcDiagnosticCode "TcRnIncorrectTyVarOnLhsOfInjCond" = 88333 GhcDiagnosticCode "TcRnUnknownTyVarsOnRhsOfInjCond" = 48254 + GhcDiagnosticCode "TcRnBadlyStaged" = 28914 + GhcDiagnosticCode "TcRnStageRestriction" = 18157 + GhcDiagnosticCode "TcRnTyThingUsedWrong" = 10969 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 @@ -595,6 +599,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "MissingBinding" = 44432 GhcDiagnosticCode "NoTopLevelBinding" = 10173 GhcDiagnosticCode "UnknownSubordinate" = 54721 + GhcDiagnosticCode "NotInScopeTc" = 76329 -- Diagnostic codes for deriving GhcDiagnosticCode "DerivErrNotWellKinded" = 62016 @@ -625,6 +630,11 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "DerivErrGenerics" = 30367 GhcDiagnosticCode "DerivErrEnumOrProduct" = 58291 + -- Diagnostic codes for instance lookup + GhcDiagnosticCode "LookupInstErrNotExact" = 10372 + GhcDiagnosticCode "LookupInstErrFlexiVar" = 10373 + GhcDiagnosticCode "LookupInstErrNotFound" = 10374 + -- TcRnEmptyStmtsGroupError/EmptyStatementGroupErrReason GhcDiagnosticCode "EmptyStmtsGroupInParallelComp" = 41242 GhcDiagnosticCode "EmptyStmtsGroupInTransformListComp" = 92693 @@ -693,6 +703,7 @@ type family ConRecursInto con where ConRecursInto "TcRnWithHsDocContext" = 'Just TcRnMessage ConRecursInto "TcRnCannotDeriveInstance" = 'Just DeriveInstanceErrReason + ConRecursInto "TcRnLookupInstance" = 'Just LookupInstanceErrReason ConRecursInto "TcRnPragmaWarning" = 'Just (WarningTxt GhcRn) ConRecursInto "TcRnNotInScope" = 'Just NotInScopeError ConRecursInto "TcRnIllegalNewtype" = 'Just IllegalNewtypeReason ===================================== testsuite/tests/annotations/should_fail/annfail03.stderr ===================================== @@ -1,5 +1,5 @@ -annfail03.hs:17:11: +annfail03.hs:17:11: [GHC-18157] GHC stage restriction: ‘InModule’ is used in a top-level splice, quasi-quote, or annotation, and must be imported, not defined locally ===================================== testsuite/tests/annotations/should_fail/annfail04.stderr ===================================== @@ -1,5 +1,5 @@ -annfail04.hs:14:12: +annfail04.hs:14:12: [GHC-18157] GHC stage restriction: instance for ‘Thing Int’ is used in a top-level splice, quasi-quote, or annotation, ===================================== testsuite/tests/annotations/should_fail/annfail06.stderr ===================================== @@ -1,5 +1,5 @@ -annfail06.hs:22:1: +annfail06.hs:22:1: [GHC-18157] GHC stage restriction: instance for ‘Data InstancesInWrongModule’ is used in a top-level splice, quasi-quote, or annotation, ===================================== testsuite/tests/annotations/should_fail/annfail09.stderr ===================================== @@ -1,5 +1,5 @@ -annfail09.hs:11:11: +annfail09.hs:11:11: [GHC-18157] GHC stage restriction: ‘g’ is used in a top-level splice, quasi-quote, or annotation, and must be imported, not defined locally ===================================== testsuite/tests/quasiquotation/qq001/qq001.stderr ===================================== @@ -1,5 +1,5 @@ -qq001.hs:7:16: +qq001.hs:7:16: [GHC-18157] GHC stage restriction: ‘parse’ is used in a top-level splice, quasi-quote, or annotation, and must be imported, not defined locally ===================================== testsuite/tests/quasiquotation/qq002/qq002.stderr ===================================== @@ -1,5 +1,5 @@ -qq002.hs:8:10: +qq002.hs:8:10: [GHC-18157] GHC stage restriction: ‘parse’ is used in a top-level splice, quasi-quote, or annotation, and must be imported, not defined locally ===================================== testsuite/tests/quasiquotation/qq003/qq003.stderr ===================================== @@ -1,5 +1,5 @@ -qq003.hs:5:26: +qq003.hs:5:26: [GHC-18157] GHC stage restriction: ‘parse’ is used in a top-level splice, quasi-quote, or annotation, and must be imported, not defined locally ===================================== testsuite/tests/quasiquotation/qq004/qq004.stderr ===================================== @@ -1,5 +1,5 @@ -qq004.hs:8:21: +qq004.hs:8:21: [GHC-18157] GHC stage restriction: ‘parse’ is used in a top-level splice, quasi-quote, or annotation, and must be imported, not defined locally ===================================== testsuite/tests/th/T17820a.stderr ===================================== @@ -1,5 +1,5 @@ -T17820a.hs:7:17: error: +T17820a.hs:7:17: error: [GHC-18157] GHC stage restriction: ‘C’ is used in a top-level splice, quasi-quote, or annotation, and must be imported, not defined locally ===================================== testsuite/tests/th/T17820b.stderr ===================================== @@ -1,5 +1,5 @@ -T17820b.hs:7:17: error: +T17820b.hs:7:17: error: [GHC-18157] GHC stage restriction: ‘f’ is used in a top-level splice, quasi-quote, or annotation, and must be imported, not defined locally ===================================== testsuite/tests/th/T17820c.stderr ===================================== @@ -1,5 +1,5 @@ -T17820c.hs:8:18: error: +T17820c.hs:8:18: error: [GHC-18157] GHC stage restriction: ‘meth’ is used in a top-level splice, quasi-quote, or annotation, and must be imported, not defined locally ===================================== testsuite/tests/th/T17820d.stderr ===================================== @@ -1,5 +1,5 @@ -T17820d.hs:6:38: error: +T17820d.hs:6:38: error: [GHC-28914] • Stage error: ‘foo’ is bound at stage 2 but used at stage 1 • In the untyped splice: $(const [| 0 |] foo) In the Template Haskell quotation ===================================== testsuite/tests/th/T17820e.stderr ===================================== @@ -1,5 +1,5 @@ -T17820e.hs:9:17: error: +T17820e.hs:9:17: error: [GHC-18157] GHC stage restriction: ‘C’ is used in a top-level splice, quasi-quote, or annotation, and must be imported, not defined locally ===================================== testsuite/tests/th/T21547.stderr ===================================== @@ -1,5 +1,5 @@ -T21547.hs:9:14: error: +T21547.hs:9:14: error: [GHC-18157] • GHC stage restriction: instance for ‘base-4.16.0.0:Data.Typeable.Internal.Typeable T’ is used in a top-level splice, quasi-quote, or annotation, ===================================== testsuite/tests/th/T5795.stderr ===================================== @@ -1,5 +1,5 @@ -T5795.hs:9:7: error: +T5795.hs:9:7: error: [GHC-18157] • GHC stage restriction: ‘ty’ is used in a top-level splice, quasi-quote, or annotation, and must be imported, not defined locally View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eeea0343f1bd5e3359c32c10fffb2a300c4924ba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eeea0343f1bd5e3359c32c10fffb2a300c4924ba You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 15:19:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 21 Mar 2023 11:19:31 -0400 Subject: [Git][ghc/ghc][master] Document pdep / pext primops Message-ID: <6419cb037174a_90da1b571ac830911e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - 1 changed file: - compiler/GHC/Builtin/primops.txt.pp Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -933,26 +933,75 @@ primop PopCntOp "popCnt#" GenPrimOp Word# -> Word# {Count the number of set bits in a word.} primop Pdep8Op "pdep8#" GenPrimOp Word# -> Word# -> Word# - {Deposit bits to lower 8 bits of a word at locations specified by a mask.} + {Deposit bits to lower 8 bits of a word at locations specified by a mask. + + @since 0.5.2.0} primop Pdep16Op "pdep16#" GenPrimOp Word# -> Word# -> Word# - {Deposit bits to lower 16 bits of a word at locations specified by a mask.} + {Deposit bits to lower 16 bits of a word at locations specified by a mask. + + @since 0.5.2.0} primop Pdep32Op "pdep32#" GenPrimOp Word# -> Word# -> Word# - {Deposit bits to lower 32 bits of a word at locations specified by a mask.} + {Deposit bits to lower 32 bits of a word at locations specified by a mask. + + @since 0.5.2.0} primop Pdep64Op "pdep64#" GenPrimOp Word64# -> Word64# -> Word64# - {Deposit bits to a word at locations specified by a mask.} + {Deposit bits to a word at locations specified by a mask. + + @since 0.5.2.0} primop PdepOp "pdep#" GenPrimOp Word# -> Word# -> Word# - {Deposit bits to a word at locations specified by a mask.} + {Deposit bits to a word at locations specified by a mask, aka + [parallel bit deposit](https://en.wikipedia.org/wiki/Bit_Manipulation_Instruction_Sets#Parallel_bit_deposit_and_extract). + + Software emulation: + + > pdep :: Word -> Word -> Word + > pdep src mask = go 0 src mask + > where + > go :: Word -> Word -> Word -> Word + > go result _ 0 = result + > go result src mask = go newResult newSrc newMask + > where + > maskCtz = countTrailingZeros mask + > newResult = if testBit src 0 then setBit result maskCtz else result + > newSrc = src `shiftR` 1 + > newMask = clearBit mask maskCtz + + @since 0.5.2.0} primop Pext8Op "pext8#" GenPrimOp Word# -> Word# -> Word# - {Extract bits from lower 8 bits of a word at locations specified by a mask.} + {Extract bits from lower 8 bits of a word at locations specified by a mask. + + @since 0.5.2.0} primop Pext16Op "pext16#" GenPrimOp Word# -> Word# -> Word# - {Extract bits from lower 16 bits of a word at locations specified by a mask.} + {Extract bits from lower 16 bits of a word at locations specified by a mask. + + @since 0.5.2.0} primop Pext32Op "pext32#" GenPrimOp Word# -> Word# -> Word# - {Extract bits from lower 32 bits of a word at locations specified by a mask.} + {Extract bits from lower 32 bits of a word at locations specified by a mask. + + @since 0.5.2.0} primop Pext64Op "pext64#" GenPrimOp Word64# -> Word64# -> Word64# - {Extract bits from a word at locations specified by a mask.} + {Extract bits from a word at locations specified by a mask. + + @since 0.5.2.0} primop PextOp "pext#" GenPrimOp Word# -> Word# -> Word# - {Extract bits from a word at locations specified by a mask.} + {Extract bits from a word at locations specified by a mask, aka + [parallel bit extract](https://en.wikipedia.org/wiki/Bit_Manipulation_Instruction_Sets#Parallel_bit_deposit_and_extract). + + Software emulation: + + > pext :: Word -> Word -> Word + > pext src mask = loop 0 0 0 + > where + > loop i count result + > | i >= finiteBitSize (0 :: Word) + > = result + > | testBit mask i + > = loop (i + 1) (count + 1) (if testBit src i then setBit result count else result) + > | otherwise + > = loop (i + 1) count result + + @since 0.5.2.0} primop Clz8Op "clz8#" GenPrimOp Word# -> Word# {Count leading zeros in the lower 8 bits of a word.} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be1d4be8d09072091b77cb68ccf234434754af00 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be1d4be8d09072091b77cb68ccf234434754af00 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 15:43:48 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 21 Mar 2023 11:43:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/tmp-fix-docs Message-ID: <6419d0b47e876_90da1b9274c432952@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/tmp-fix-docs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/tmp-fix-docs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 15:45:50 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 21 Mar 2023 11:45:50 -0400 Subject: [Git][ghc/ghc][wip/romes/tmp-fix-docs] fix: Incorrect @since annotations in GHC.TypeError Message-ID: <6419d12ec7c61_90da1c0174a03323d6@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/tmp-fix-docs at Glasgow Haskell Compiler / GHC Commits: 6687b74c by romes at 2023-03-21T15:45:42+00:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - 2 changed files: - libraries/base/GHC/TypeError.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/GHC/TypeError.hs ===================================== @@ -12,7 +12,7 @@ This module exports the TypeError family, which is used to provide custom type errors, and the ErrorMessage kind used to define these custom error messages. This is a type-level analogue to the term level error function. - at since 4.16.0.0 + at since 4.17.0.0 -} module GHC.TypeError @@ -132,7 +132,7 @@ equation of Assert kicks in, and -- where @NotPError@ reduces to a @TypeError@ which is reported if the -- assertion fails. -- --- @since 4.16.0.0 +-- @since 4.17.0.0 -- type Assert :: Bool -> Constraint -> Constraint type family Assert check errMsg where ===================================== libraries/base/changelog.md ===================================== @@ -168,6 +168,9 @@ errors. `TypeError` is re-exported from `GHC.TypeLits` for backwards compatibility. + * Comparison constraints in `Data.Type.Ord` (e.g. `<=`) now use the new + `GHC.TypeError.Assert` type family instead of type equality with `~`. + ## 4.16.3.0 *May 2022* * Shipped with GHC 9.2.4 @@ -245,9 +248,6 @@ * `fromInteger :: Integer -> Float/Double` now consistently round to the nearest value, with ties to even. - * Comparison constraints in `Data.Type.Ord` (e.g. `<=`) now use the new - `GHC.TypeError.Assert` type family instead of type equality with `~`. - * Additions to `Data.Bits`: - Newtypes `And`, `Ior`, `Xor` and `Iff` which wrap their argument, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6687b74c160cafc59fb2c1a96c3048a33f113efd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6687b74c160cafc59fb2c1a96c3048a33f113efd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 16:18:17 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 21 Mar 2023 12:18:17 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] WIP: Better Hash Message-ID: <6419d8c978adc_90da1ce3f7bc3640c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 19f95b6e by romes at 2023-03-21T16:18:02+00:00 WIP: Better Hash Co-author: @mpickering TODO: Fix identifier of rts which is depended on. What about the simple identifiers in haddocks? Perhaps we only need the full unitid for the pacckage databases. If filepaths have hashes then cabal can't parse them The wrong way to handle this. Reverting... Revert "If filepaths have hashes then cabal can't parse them" This reverts commit 91d45aee4e3509fd258c498f5f19b0efedd58fbc. Revert "Revert "If filepaths have hashes then cabal can't parse them"" This reverts commit 4aab197ed680cc5d192c4845c009c4bd1871535e. IWP - - - - - 18 changed files: - hadrian/hadrian.cabal - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - + hadrian/src/Hadrian/Haskell/Hash.hs - + hadrian/src/Hadrian/Haskell/Hash.hs-boot - hadrian/src/Hadrian/Package.hs - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Haddock.hs Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -55,6 +55,7 @@ executable hadrian , Hadrian.BuildPath , Hadrian.Expression , Hadrian.Haskell.Cabal + , Hadrian.Haskell.Hash , Hadrian.Haskell.Cabal.Type , Hadrian.Haskell.Cabal.Parse , Hadrian.Oracles.ArgsHash @@ -163,6 +164,8 @@ executable hadrian , transformers >= 0.4 && < 0.7 , unordered-containers >= 0.2.1 && < 0.3 , text >= 1.2 && < 3 + , cryptohash-sha256 >= 0.11 && < 0.12 + , base16-bytestring >= 0.1.1 && < 1.1.0.0 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Context.hs ===================================== @@ -70,15 +70,15 @@ distDir st = do hostArch <- cabalArchString <$> setting arch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version -pkgFileName :: Package -> String -> String -> Action FilePath -pkgFileName package prefix suffix = do - pid <- pkgIdentifier package +pkgFileName :: Context -> Package -> String -> String -> Action FilePath +pkgFileName context package prefix suffix = do + pid <- pkgUnitId context package return $ prefix ++ pid ++ suffix pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - fileName <- pkgFileName package prefix suffix + fileName <- pkgFileName context package prefix suffix return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. @@ -95,9 +95,9 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile Context {..} = do +pkgHaddockFile context at Context {..} = do root <- buildRoot - version <- pkgIdentifier package + version <- pkgUnitId context package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: @@ -106,7 +106,7 @@ pkgHaddockFile Context {..} = do pkgRegisteredLibraryFile :: Context -> Action FilePath pkgRegisteredLibraryFile context at Context {..} = do libDir <- libPath context - pkgId <- pkgIdentifier package + pkgId <- pkgUnitId context package fileName <- pkgRegisteredLibraryFileName context distDir <- distDir stage return $ if Dynamic `wayUnit` way @@ -115,9 +115,9 @@ pkgRegisteredLibraryFile context at Context {..} = do -- | Just the final filename portion of pkgRegisteredLibraryFile pkgRegisteredLibraryFileName :: Context -> Action FilePath -pkgRegisteredLibraryFileName Context{..} = do +pkgRegisteredLibraryFileName context at Context{..} = do extension <- libsuf stage way - pkgFileName package "libHS" extension + pkgFileName context package "libHS" extension -- | Path to the library file of a given 'Context', e.g.: @@ -136,8 +136,8 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile Context {..} = do - pid <- pkgIdentifier package +pkgConfFile context at Context {..} = do + pid <- pkgUnitId context package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -112,16 +112,24 @@ parseWayUnit = Parsec.choice -- | Parse a @"pkgname-pkgversion"@ string into the package name and the -- integers that make up the package version. -parsePkgId :: Parsec.Parsec String () (String, [Integer]) -parsePkgId = parsePkgId' "" Parsec. "package identifier (-)" +parsePkgId :: Parsec.Parsec String () (String, [Integer], String) +parsePkgId = parseRTS <|> (parsePkgId' "" Parsec. "package identifier (--)") where parsePkgId' currName = do s <- Parsec.many1 Parsec.alphaNum _ <- Parsec.char '-' let newName = if null currName then s else currName ++ "-" ++ s - Parsec.choice [ (newName,) <$> parsePkgVersion + Parsec.choice [ (,,) newName <$> parsePkgVersion <*> (Parsec.char '-' *> parsePkgHash) , parsePkgId' newName ] + parseRTS = do + _ <- Parsec.string "rts" <* Parsec.char '-' + v <- parsePkgVersion + pure ("rts", v, "") + +parsePkgHash :: Parsec.Parsec String () String +parsePkgHash = Parsec.many1 Parsec.alphaNum + -- | Parse "."-separated integers that describe a package's version. parsePkgVersion :: Parsec.Parsec String () [Integer] parsePkgVersion = fmap reverse (parsePkgVersion' []) ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -10,8 +10,8 @@ -- Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( - pkgVersion, pkgIdentifier, pkgSynopsis, pkgDescription, pkgDependencies, - pkgGenericDescription, cabalArchString, cabalOsString, + pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, + pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString ) where import Development.Shake @@ -20,20 +20,13 @@ import Distribution.PackageDescription (GenericPackageDescription) import Hadrian.Haskell.Cabal.Type import Hadrian.Oracles.Cabal import Hadrian.Package +import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId) + -- | Read a Cabal file and return the package version. The Cabal file is tracked. pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData --- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0 at . --- The Cabal file is tracked. -pkgIdentifier :: Package -> Action String -pkgIdentifier package = do - cabal <- readPackageData package - return $ if null (version cabal) - then name cabal - else name cabal ++ "-" ++ version cabal - -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. pkgSynopsis :: Package -> Action String pkgSynopsis = fmap synopsis . readPackageData @@ -72,3 +65,4 @@ cabalOsString "mingw32" = "windows" cabalOsString "darwin" = "osx" cabalOsString "solaris2" = "solaris" cabalOsString other = other + ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -345,7 +345,7 @@ registerPackage rs context = do pd <- packageDescription <$> readContextData context db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context)) dist_dir <- Context.buildPath context - pid <- pkgIdentifier (package context) + pid <- pkgUnitId context (package context) -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path -- from the local build info @lbi at . lbi <- liftIO $ C.getPersistBuildConfig cPath @@ -357,12 +357,12 @@ registerPackage rs context = do -- This is copied and simplified from Cabal, because we want to install the package -- into a different package database to the one it was configured against. register :: FilePath - -> FilePath + -> String -- ^ Package Identifier -> FilePath -> C.PackageDescription -> LocalBuildInfo -> IO () -register pkg_db conf_file build_dir pd lbi +register pkg_db pid build_dir pd lbi = withLibLBI pd lbi $ \lib clbi -> do absPackageDBs <- C.absolutePackageDBPaths packageDbs @@ -373,13 +373,13 @@ register pkg_db conf_file build_dir pd lbi writeRegistrationFile installedPkgInfo where - regFile = conf_file + regFile = pkg_db pid <.> "conf" reloc = relocatable lbi -- Using a specific package db here is why we have to copy the function from Cabal. packageDbs = [C.SpecificPackageDB pkg_db] writeRegistrationFile installedPkgInfo = do - writeUTF8File (pkg_db regFile <.> "conf") (CP.showInstalledPackageInfo installedPkgInfo) + writeUTF8File regFile (CP.showInstalledPackageInfo installedPkgInfo) -- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs at . ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -0,0 +1,245 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where + +import Development.Shake + +import Hadrian.Haskell.Cabal.Type as C +import Hadrian.Haskell.Cabal +import Hadrian.Oracles.Cabal +import Hadrian.Package + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as BS +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import Data.List +import Context.Type +import Oracles.Setting +import Hadrian.Target +import Hadrian.Expression +import Builder +import Flavour.Type +import Settings +import Way.Type +import Way +import Packages +import Development.Shake.Classes +import Control.Monad + + +-- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd at . +-- This needs to be an oracle so it's cached +pkgUnitId :: Context -> Package -> Action String +pkgUnitId ctx' pkg = do + let ctx = ctx'{package = pkg} + pid <- pkgSimpleIdentifier (package ctx) + phash <- pkgHash ctx + if pkgName pkg == "rts" + -- The Unit-id will change depending on the way... rTS BReaks. At some + -- point it's not even clear which way we're building + then pure pid + else do + -- Other boot packages still hardcode their unit-id to just , but we + -- can have hadrian generate a different unit-id for them just as cabal does + -- because the boot packages unit-ids are overriden by setting -this-unit-id + -- in the cabal file + -- liftIO $ print $ pid <> "-" <> truncateHash 4 phash + pure $ pid <> "-" <> truncateHash 4 phash + + where + truncateHash :: Int -> String -> String + truncateHash = take + +-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . +-- The Cabal file is tracked. +-- +-- For an identifier complete with the hash use 'pkgUnitId' +pkgSimpleIdentifier :: Package -> Action String +pkgSimpleIdentifier package = do + cabal <- readPackageData package + return $ if null (version cabal) + then C.name cabal + else C.name cabal ++ "-" ++ version cabal + +data PackageHashInputs = PackageHashInputs { + pkgHashPkgId :: String, -- ^ name-version + pkgHashComponent :: PackageType, + pkgHashSourceHash :: BS.ByteString, + -- pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion), + pkgHashDirectDeps :: Set.Set String, + pkgHashOtherConfig :: PackageHashConfigInputs + } + +-- | Those parts of the package configuration that contribute to the +-- package hash computed by hadrian (which is simpler than cabal's). +-- +-- setting in Oracle.setting, which come from system.config +data PackageHashConfigInputs = PackageHashConfigInputs { + pkgHashCompilerId :: String, + pkgHashPlatform :: String, + pkgHashFlagAssignment :: [String], -- complete not partial + -- pkgHashConfigureScriptArgs :: [String], -- just ./configure for build-type Configure + pkgHashVanillaLib :: Bool, + pkgHashSharedLib :: Bool, + pkgHashDynExe :: Bool, + pkgHashFullyStaticExe :: Bool, + pkgHashGHCiLib :: Bool, + pkgHashProfLib :: Bool, + pkgHashProfExe :: Bool, +-- pkgHashProfLibDetail :: ProfDetailLevel, +-- pkgHashProfExeDetail :: ProfDetailLevel, + pkgHashCoverage :: Bool, + pkgHashOptimization :: Int, + pkgHashSplitObjs :: Bool, + pkgHashSplitSections :: Bool, + pkgHashStripLibs :: Bool, + pkgHashStripExes :: Bool, +-- pkgHashDebugInfo :: DebugInfoLevel, + pkgHashProgramArgs :: Map String [String], + pkgHashExtraLibDirs :: [FilePath], + pkgHashExtraLibDirsStatic :: [FilePath], + pkgHashExtraFrameworkDirs :: [FilePath], + pkgHashExtraIncludeDirs :: [FilePath] + -- pkgHashProgPrefix :: Maybe PathTemplate, + -- pkgHashProgSuffix :: Maybe PathTemplate, + -- pkgHashPackageDbs :: [Maybe PackageDB] + } + deriving Show + +newtype PkgHashKey = PkgHashKey Context + deriving (Binary, Eq, Hashable, NFData, Show, Typeable) +type instance RuleResult PkgHashKey = String + +pkgHash :: Context -> Action String +pkgHash = askOracle . PkgHashKey + +-- TODO: Needs to be oracle to be cached? Called lots of times +pkgHashOracle :: Rules () +pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do + -- RECURSIVE ORACLE: ctx_data <- readContextData ctx + pkg_data <- readPackageData (package ctx) + name <- pkgSimpleIdentifier (package ctx) + let stag = stage ctx + liftIO $ print ("Package and Package Dependencies", package ctx, packageDependencies pkg_data) + stagePkgs <- stagePackages stag + depsHashes <- mapM (\pkg -> pkgHash (ctx { package = pkg })) [pkg | pkg <- packageDependencies pkg_data, pkg `elem` stagePkgs] + liftIO $ print ("Pkg Deps Hashes", depsHashes) + flav <- flavour + let flavourArgs = args flav + + targetOs <- setting TargetOs + let pkgHashCompilerId = "" + pkgHashPlatform = targetOs + libWays <- interpretInContext ctx (libraryWays flav) + dyn_ghc <- dynamicGhcPrograms flav + flags <- interpret (target ctx (Cabal Flags stag) [] []) flavourArgs + let pkgHashFlagAssignment = flags + pkgHashConfigureScriptArgs = "" + pkgHashVanillaLib = vanilla `Set.member` libWays + pkgHashSharedLib = dynamic `Set.member` libWays + pkgHashDynExe = dyn_ghc + -- TODO: fullyStatic flavour transformer + pkgHashFullyStaticExe = False + pkgHashGHCiLib = False + pkgHashProfLib = profiling `Set.member` libWays + pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag + pkgHashCoverage = False -- Can't configure this + pkgHashOptimization = 0 -- TODO: A bit tricky to configure + pkgHashSplitObjs = False -- Deprecated + pkgHashSplitSections = ghcSplitSections flav + pkgHashStripExes = False + pkgHashStripLibs = False + pkgHashDebugInfo = undefined + + -- ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs + let pkgHashProgramArgs = mempty -- Map.singleton "ghc" ghcArgs + pkgHashExtraLibDirs = [] + pkgHashExtraLibDirsStatic = [] + pkgHashExtraFrameworkDirs = [] + pkgHashExtraIncludeDirs = [] + + let other_config = PackageHashConfigInputs{..} + + return $ BS.unpack $ Base16.encode $ SHA256.hash $ + renderPackageHashInputs $ PackageHashInputs + { + pkgHashPkgId = name + , pkgHashComponent = pkgType (package ctx) + , pkgHashSourceHash = "" + , pkgHashDirectDeps = Set.empty + , pkgHashOtherConfig = other_config + } + +prettyShow, showHashValue :: Show a => a -> String +prettyShow = show +showHashValue = show + +renderPackageHashInputs :: PackageHashInputs -> BS.ByteString +renderPackageHashInputs PackageHashInputs{ + pkgHashPkgId, + pkgHashComponent, + pkgHashSourceHash, + pkgHashDirectDeps, + -- pkgHashPkgConfigDeps, + pkgHashOtherConfig = + PackageHashConfigInputs{..} + } = + -- The purpose of this somewhat laboured rendering (e.g. why not just + -- use show?) is so that existing package hashes do not change + -- unnecessarily when new configuration inputs are added into the hash. + BS.pack $ unlines $ catMaybes $ + [ entry "pkgid" prettyShow pkgHashPkgId +-- , mentry "component" show pkgHashComponent + , entry "src" showHashValue pkgHashSourceHash + {- + , entry "pkg-config-deps" + (intercalate ", " . map (\(pn, mb_v) -> prettyShow pn ++ + case mb_v of + Nothing -> "" + Just v -> " " ++ prettyShow v) + . Set.toList) pkgHashPkgConfigDeps + -} + , entry "deps" (intercalate ", " . map prettyShow + . Set.toList) pkgHashDirectDeps + -- and then all the config + , entry "compilerid" prettyShow pkgHashCompilerId + , entry "platform" prettyShow pkgHashPlatform + , opt "flags" mempty show pkgHashFlagAssignment +-- , opt "configure-script" [] unwords pkgHashConfigureScriptArgs + , opt "vanilla-lib" True prettyShow pkgHashVanillaLib + , opt "shared-lib" False prettyShow pkgHashSharedLib + , opt "dynamic-exe" False prettyShow pkgHashDynExe + , opt "fully-static-exe" False prettyShow pkgHashFullyStaticExe + , opt "ghci-lib" False prettyShow pkgHashGHCiLib + , opt "prof-lib" False prettyShow pkgHashProfLib + , opt "prof-exe" False prettyShow pkgHashProfExe + -- , opt "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail + -- , opt "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail + , opt "hpc" False prettyShow pkgHashCoverage + , opt "optimisation" 0 (show) pkgHashOptimization + , opt "split-objs" False prettyShow pkgHashSplitObjs + , opt "split-sections" False prettyShow pkgHashSplitSections + , opt "stripped-lib" False prettyShow pkgHashStripLibs + , opt "stripped-exe" True prettyShow pkgHashStripExes +-- , opt "debug-info" NormalDebugInfo (show . fromEnum) pkgHashDebugInfo + , opt "extra-lib-dirs" [] unwords pkgHashExtraLibDirs + , opt "extra-lib-dirs-static" [] unwords pkgHashExtraLibDirsStatic + , opt "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs + , opt "extra-include-dirs" [] unwords pkgHashExtraIncludeDirs +-- , opt "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix +-- , opt "prog-suffix" Nothing (maybe "" fromPathTemplate) pkgHashProgSuffix +-- , opt "package-dbs" [] (unwords . map show) pkgHashPackageDbs + + ] ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs + where + entry key format value = Just (key ++ ": " ++ format value) + mentry key format value = fmap (\v -> key ++ ": " ++ format v) value + opt key def format value + | value == def = Nothing + | otherwise = entry key format value ===================================== hadrian/src/Hadrian/Haskell/Hash.hs-boot ===================================== @@ -0,0 +1,8 @@ +module Hadrian.Haskell.Hash where + +import Context.Type +import Hadrian.Package +import Development.Shake + +pkgUnitId :: Context -> Package -> Action String + ===================================== hadrian/src/Hadrian/Package.hs ===================================== @@ -81,4 +81,4 @@ instance NFData PackageType instance Binary Package instance Hashable Package -instance NFData Package \ No newline at end of file +instance NFData Package ===================================== hadrian/src/Rules.hs ===================================== @@ -8,6 +8,7 @@ import qualified Hadrian.Oracles.Cabal.Rules import qualified Hadrian.Oracles.DirectoryContents import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile +import qualified Hadrian.Haskell.Hash import Expression import qualified Oracles.Flavour @@ -142,6 +143,7 @@ oracleRules :: Rules () oracleRules = do Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs Hadrian.Oracles.Cabal.Rules.cabalOracle + Hadrian.Haskell.Hash.pkgHashOracle Hadrian.Oracles.DirectoryContents.directoryContentsOracle Hadrian.Oracles.Path.pathOracle Hadrian.Oracles.TextFile.textFileOracle ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,7 +132,8 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -10,7 +10,7 @@ import Utilities import qualified System.Directory.Extra as IO import Data.Either import Rules.BinaryDist -import Hadrian.Haskell.Cabal (pkgIdentifier) +import Hadrian.Haskell.Cabal (pkgUnitId) import Oracles.Setting {- @@ -54,7 +54,8 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -293,7 +293,7 @@ parsePkgDocTarget root = do _ <- Parsec.string root *> Parsec.optional (Parsec.char '/') _ <- Parsec.string (htmlRoot ++ "/") _ <- Parsec.string "libraries/" - (pkgname, _) <- parsePkgId <* Parsec.char '/' + (pkgname, _, _) <- parsePkgId <* Parsec.char '/' Parsec.choice [ Parsec.try (Parsec.string "haddock-prologue.txt") *> pure (HaddockPrologue pkgname) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -14,6 +14,7 @@ import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting import Hadrian.Haskell.Cabal.Type (PackageData(version)) +import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal (readPackageData) import Packages import Rules.Libffi @@ -487,16 +488,15 @@ generateConfigHs = do trackGenerateHs cProjectName <- getSetting ProjectName cBooterVersion <- getSetting GhcVersion - cProjectVersionMunged <- getSetting ProjectVersionMunged - -- ROMES:TODO:HASH First we attempt a fixed unit-id with version but without hash. - -- - -- We now use a more informative unit-id for ghc. See Note [GHC's Unit Id] - -- in GHC.Unit.Types + -- We now give a unit-id with a version and a hash to ghc. + -- See Note [GHC's Unit Id] in GHC.Unit.Types -- -- It's crucial that the unit-id matches the unit-key -- ghc is no longer -- part of the WiringMap, so we don't to go back and forth between the - -- unit-id and the unit-key -- we take care here that they are the same. - let cProjectUnitId = "ghc-" ++ cProjectVersionMunged -- ROMES:TODO:HASH + -- unit-id and the unit-key -- we take care that they are the same by using + -- 'pkgUnitId' on 'compiler' (the ghc-library package) to create the + -- unit-id in both situations. + cProjectUnitId <- expr . (`pkgUnitId` compiler) =<< getContext return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -593,3 +593,5 @@ generatePlatformHostHs = do , "hostPlatformArchOS :: ArchOS" , "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS" ] + + ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -45,7 +45,7 @@ libraryRules = do registerStaticLib :: FilePath -> FilePath -> Action () registerStaticLib root archivePath = do -- Simply need the ghc-pkg database .conf file. - GhcPkgPath _ stage _ (LibA name _ w) + GhcPkgPath _ stage _ (LibA name _ _ w) <- parsePath (parseGhcPkgLibA root) "<.a library (register) path parser>" archivePath @@ -56,7 +56,7 @@ registerStaticLib root archivePath = do -- the second argument. buildStaticLib :: FilePath -> FilePath -> Action () buildStaticLib root archivePath = do - l@(BuildPath _ stage _ (LibA pkgname _ way)) + l@(BuildPath _ stage _ (LibA pkgname _ _ way)) <- parsePath (parseBuildLibA root) "<.a library (build) path parser>" archivePath @@ -75,7 +75,7 @@ buildStaticLib root archivePath = do registerDynamicLib :: FilePath -> String -> FilePath -> Action () registerDynamicLib root suffix dynlibpath = do -- Simply need the ghc-pkg database .conf file. - (GhcPkgPath _ stage _ (LibDyn name _ w _)) + (GhcPkgPath _ stage _ (LibDyn name _ _ w _)) <- parsePath (parseGhcPkgLibDyn root suffix) "" dynlibpath @@ -99,7 +99,7 @@ buildDynamicLib root suffix dynlibpath = do -- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. buildGhciLibO :: FilePath -> FilePath -> Action () buildGhciLibO root ghcilibPath = do - l@(BuildPath _ stage _ (LibGhci _ _ _)) + l@(BuildPath _ stage _ (LibGhci _ _ _ _)) <- parsePath (parseBuildLibGhci root) "<.o ghci lib (build) path parser>" ghcilibPath @@ -134,7 +134,7 @@ files etc. buildPackage :: FilePath -> FilePath -> Action () buildPackage root fp = do - l@(BuildPath _ _ _ (PkgStamp _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp + l@(BuildPath _ _ _ (PkgStamp _ _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp let ctx = stampContext l srcs <- hsSources ctx gens <- interpretInContext ctx generatedDependencies @@ -226,47 +226,47 @@ needLibrary cs = need =<< concatMapM (libraryTargets True) cs -- * Library paths types and parsers --- | > libHS-[_].a -data LibA = LibA String [Integer] Way deriving (Eq, Show) +-- | > libHS--[_].a +data LibA = LibA String [Integer] String Way deriving (Eq, Show) -- | > data DynLibExt = So | Dylib deriving (Eq, Show) --- | > libHS-[_]-ghc. -data LibDyn = LibDyn String [Integer] Way DynLibExt deriving (Eq, Show) +-- | > libHS--[_]-ghc. +data LibDyn = LibDyn String [Integer] String Way DynLibExt deriving (Eq, Show) --- | > HS-[_].o -data LibGhci = LibGhci String [Integer] Way deriving (Eq, Show) +-- | > HS--[_].o +data LibGhci = LibGhci String [Integer] String Way deriving (Eq, Show) -- | Get the 'Context' corresponding to the build path for a given static library. libAContext :: BuildPath LibA -> Context -libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) = +libAContext (BuildPath _ stage pkgpath (LibA pkgname _ _ way)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given GHCi library. libGhciContext :: BuildPath LibGhci -> Context -libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) = +libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ _ way)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given dynamic library. libDynContext :: BuildPath LibDyn -> Context -libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = +libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ _ way _)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given static library. stampContext :: BuildPath PkgStamp -> Context -stampContext (BuildPath _ stage _ (PkgStamp pkgname _ way)) = +stampContext (BuildPath _ stage _ (PkgStamp pkgname _ _ way)) = Context stage pkg way Final where pkg = unsafeFindPackageByName pkgname -data PkgStamp = PkgStamp String [Integer] Way deriving (Eq, Show) +data PkgStamp = PkgStamp String [Integer] String Way deriving (Eq, Show) -- | Parse a path to a ghci library to be built, making sure the path starts @@ -313,34 +313,34 @@ parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext) parseLibAFilename :: Parsec.Parsec String () LibA parseLibAFilename = do _ <- Parsec.string "libHS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- parseWaySuffix vanilla _ <- Parsec.string ".a" - return (LibA pkgname pkgver way) + return (LibA pkgname pkgver pkghash way) -- | Parse the filename of a ghci library to be built into a 'LibGhci' value. parseLibGhciFilename :: Parsec.Parsec String () LibGhci parseLibGhciFilename = do _ <- Parsec.string "HS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId _ <- Parsec.string "." way <- parseWayPrefix vanilla _ <- Parsec.string "o" - return (LibGhci pkgname pkgver way) + return (LibGhci pkgname pkgver pkghash way) -- | Parse the filename of a dynamic library to be built into a 'LibDyn' value. parseLibDynFilename :: String -> Parsec.Parsec String () LibDyn parseLibDynFilename ext = do _ <- Parsec.string "libHS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- addWayUnit Dynamic <$> parseWaySuffix dynamic _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion _ <- Parsec.string ("." ++ ext) - return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) + return (LibDyn pkgname pkgver pkghash way $ if ext == "so" then So else Dylib) parseStamp :: Parsec.Parsec String () PkgStamp parseStamp = do _ <- Parsec.string "stamp-" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- parseWaySuffix vanilla - return (PkgStamp pkgname pkgver way) + return (PkgStamp pkgname pkgver pkghash way) ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeApplications #-} module Rules.Register ( configurePackageRules, registerPackageRules, registerPackages, libraryTargets @@ -20,11 +21,15 @@ import Utilities import Hadrian.Haskell.Cabal.Type import qualified Text.Parsec as Parsec import qualified Data.Set as Set +import qualified Data.Char as Char +import Data.Bifunctor (bimap) import Distribution.Version (Version) -import qualified Distribution.Parsec as Cabal -import qualified Distribution.Types.PackageName as Cabal import qualified Distribution.Types.PackageId as Cabal +import qualified Distribution.Types.PackageName as Cabal +import qualified Distribution.Parsec as Cabal +import qualified Distribution.Parsec.FieldLineStream as Cabal +import qualified Distribution.Compat.CharParsing as CabalCharParsing import qualified Hadrian.Haskell.Cabal.Parse as Cabal import qualified System.Directory as IO @@ -183,7 +188,7 @@ buildConfFinal rs context at Context {..} _conf = do -- so that if any change ends up modifying a library (but not its .conf -- file), we still rebuild things that depend on it. dir <- (-/-) <$> libPath context <*> distDir stage - pkgid <- pkgIdentifier package + pkgid <- pkgUnitId context package files <- liftIO $ (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] @@ -251,11 +256,32 @@ getPackageNameFromConfFile conf takeBaseName conf ++ ": " ++ err Right (name, _) -> return name +-- | Parse a cabal-like name parseCabalName :: String -> Either String (String, Version) -parseCabalName = fmap f . Cabal.eitherParsec +-- Try to parse a name with a hash, but otherwise parse a name without one. +parseCabalName s = bimap show id (Cabal.runParsecParser nameWithHashParser "" $ Cabal.fieldLineStreamFromString s) + <|> fmap f (Cabal.eitherParsec s) where f :: Cabal.PackageId -> (String, Version) f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id) + -- Definition similar to 'Parsec PackageIdentifier' from Cabal but extended + -- with logic for parsing the hash (despite not returning it) + nameWithHashParser :: Cabal.ParsecParser (String, Version) + nameWithHashParser = Cabal.PP $ \_ -> do + xs' <- Parsec.sepBy component (Parsec.char '-') + case reverse xs' of + hash:version_str:xs -> + case Cabal.simpleParsec @Version version_str of + Nothing -> fail ("failed to parse a version from " <> version_str) + Just v -> + if not (null xs) && all (\c -> all (/= '.') c && not (all Char.isDigit c)) xs + then return $ (intercalate "-" (reverse xs), v) + else fail "all digits or a dot in a portion of package name" + _ -> fail "couldn't parse a hash, a version and a name" + where + component = CabalCharParsing.munch1 (\c -> Char.isAlphaNum c || c == '.') + + -- | Return extra library targets. extraTargets :: Context -> Action [FilePath] ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -84,8 +84,9 @@ cabalSetupArgs = builder (Cabal Setup) ? do commonCabalArgs :: Stage -> Args commonCabalArgs stage = do verbosity <- expr getVerbosity + ctx <- getContext pkg <- getPackage - package_id <- expr $ pkgIdentifier pkg + package_id <- expr $ pkgUnitId ctx pkg let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..") mconcat [ -- Don't strip libraries when cross compiling. -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, @@ -101,7 +102,7 @@ commonCabalArgs stage = do , arg "--cabal-file" , arg $ pkgCabalFile pkg , arg "--ipid" - , arg "$pkg-$version" + , arg package_id , arg "--prefix" , arg prefix ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -243,21 +243,24 @@ wayGhcArgs = do , (way == debug || way == debugDynamic) ? pure ["-ticky", "-DTICKY_TICKY"] ] +-- | Args related to correct handling of packages, such as setting +-- -this-unit-id and passing -package-id for dependencies packageGhcArgs :: Args packageGhcArgs = do package <- getPackage + ctx <- getContext ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) -- ROMES: Until the boot compiler no longer needs ghc's -- unit-id to be "ghc", the stage0 compiler must be built -- with `-this-unit-id ghc`, while the wired-in unit-id of -- ghc is correctly set to the unit-id we'll generate for - -- stage1 (set in generateVersionHs in Rules.Generate). + -- stage1 (set in generateConfigHs in Rules.Generate). -- -- However, we don't need to set the unit-id of "ghc" to "ghc" when -- building stage0 because we have a flag in compiler/ghc.cabal.in that is -- sets `-this-unit-id ghc` when hadrian is building stage0, which will -- overwrite this one. - pkgId <- expr $ pkgIdentifier package + pkgId <- expr $ pkgUnitId ctx package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -42,7 +42,7 @@ haddockBuilderArgs = mconcat version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg haddocks <- expr $ haddockDependencies context - haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks] + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgUnitId context p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/19f95b6e29cd3f24363bc886806cb0aa21805a33 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/19f95b6e29cd3f24363bc886806cb0aa21805a33 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 16:20:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 21 Mar 2023 12:20:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Rename () into Unit, (,,...,,) into Tuple (#21294) Message-ID: <6419d967ef3bc_90da1ce27c7036465e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - 171eb128 by Alex Mason at 2023-03-21T12:20:48-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - c111986a by Luite Stegeman at 2023-03-21T12:20:50-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types.hs-boot - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Types/Name/Cache.hs - compiler/GHC/Types/Name/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53b92fe1e1a2ab4839673811aad9309c078e8cef...c111986a286e9139038779e02abdfe23c1b170fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53b92fe1e1a2ab4839673811aad9309c078e8cef...c111986a286e9139038779e02abdfe23c1b170fc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 16:45:07 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Tue, 21 Mar 2023 12:45:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23145 Message-ID: <6419df1317f87_90da1d7862e4374125@gitlab.mail> Sebastian Graf pushed new branch wip/T23145 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23145 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 17:05:50 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Tue, 21 Mar 2023 13:05:50 -0400 Subject: [Git][ghc/ghc][wip/amg/warning-categories] 10 commits: Rename () into Unit, (,,...,,) into Tuple (#21294) Message-ID: <6419e3ee45e82_90da1deb50ec3798bd@gitlab.mail> Adam Gundry pushed to branch wip/amg/warning-categories at Glasgow Haskell Compiler / GHC Commits: a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - 7f651cc5 by Adam Gundry at 2023-03-21T17:05:30+00:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 8ed49d0d by Adam Gundry at 2023-03-21T17:05:32+00:00 Move mention of warning groups change to 9.8.1 release notes - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types.hs-boot - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9d3fdd1b6f5339b51fe0e31ece35ef75532ad1b...8ed49d0d85fca01f05502581f483a6607ebe8560 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9d3fdd1b6f5339b51fe0e31ece35ef75532ad1b...8ed49d0d85fca01f05502581f483a6607ebe8560 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 18:15:20 2023 From: gitlab at gitlab.haskell.org (ase (@adamse)) Date: Tue, 21 Mar 2023 14:15:20 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/adamse/stableptr-clarifications Message-ID: <6419f438a4c21_90da1ed2170c3947a2@gitlab.mail> ase pushed new branch wip/adamse/stableptr-clarifications at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/adamse/stableptr-clarifications You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 22:11:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 21 Mar 2023 18:11:46 -0400 Subject: [Git][ghc/ghc][master] Allow LLVM backend to use HDoc for faster file generation. Message-ID: <641a2ba22f961_90da22f0f2404344c8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - 8 changed files: - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs Changes: ===================================== compiler/GHC/CmmToLlvm.hs ===================================== @@ -91,7 +91,7 @@ llvmCodeGen logger cfg h cmm_stream llvmCodeGen' :: LlvmCgConfig -> Stream.Stream IO RawCmmGroup a -> LlvmM a llvmCodeGen' cfg cmm_stream = do -- Preamble - renderLlvm header + renderLlvm (llvmHeader cfg) (llvmHeader cfg) ghcInternalFunctions cmmMetaLlvmPrelude @@ -99,20 +99,23 @@ llvmCodeGen' cfg cmm_stream a <- Stream.consume cmm_stream liftIO llvmGroupLlvmGens -- Declare aliases for forward references - renderLlvm . pprLlvmData cfg =<< generateExternDecls + decls <- generateExternDecls + renderLlvm (pprLlvmData cfg decls) + (pprLlvmData cfg decls) -- Postamble cmmUsedLlvmGens return a - where - header :: SDoc - header = - let target = llvmCgLlvmTarget cfg - llvmCfg = llvmCgLlvmConfig cfg - in (text "target datalayout = \"" <> text (getDataLayout llvmCfg target) <> text "\"") - $+$ (text "target triple = \"" <> text target <> text "\"") +llvmHeader :: IsDoc doc => LlvmCgConfig -> doc +llvmHeader cfg = + let target = llvmCgLlvmTarget cfg + llvmCfg = llvmCgLlvmConfig cfg + in lines_ + [ text "target datalayout = \"" <> text (getDataLayout llvmCfg target) <> text "\"" + , text "target triple = \"" <> text target <> text "\"" ] + where getDataLayout :: LlvmConfig -> String -> String getDataLayout config target = case lookup target (llvmTargets config) of @@ -121,6 +124,8 @@ llvmCodeGen' cfg cmm_stream text "Target:" <+> text target $$ hang (text "Available targets:") 4 (vcat $ map (text . fst) $ llvmTargets config) +{-# SPECIALIZE llvmHeader :: LlvmCgConfig -> SDoc #-} +{-# SPECIALIZE llvmHeader :: LlvmCgConfig -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable llvmGroupLlvmGens :: RawCmmGroup -> LlvmM () llvmGroupLlvmGens cmm = do @@ -156,10 +161,11 @@ cmmDataLlvmGens statics = funInsert l ty regGlobal _ = pure () mapM_ regGlobal gs - gss' <- mapM aliasify $ gs + gss' <- mapM aliasify gs cfg <- getConfig - renderLlvm $ pprLlvmData cfg (concat gss', concat tss) + renderLlvm (pprLlvmData cfg (concat gss', concat tss)) + (pprLlvmData cfg (concat gss', concat tss)) -- | Complete LLVM code generation phase for a single top-level chunk of Cmm. cmmLlvmGen ::RawCmmDecl -> LlvmM () @@ -175,12 +181,12 @@ cmmLlvmGen cmm at CmmProc{} = do -- generate llvm code from cmm llvmBC <- withClearVars $ genLlvmProc fixed_cmm - -- pretty print - (docs, ivars) <- fmap unzip $ mapM pprLlvmCmmDecl llvmBC - - -- Output, note down used variables - renderLlvm (vcat docs) - mapM_ markUsedVar $ concat ivars + -- pretty print - print as we go, since we produce HDocs, we know + -- no nesting state needs to be maintained for the SDocs. + forM_ llvmBC (\decl -> do + (hdoc, sdoc) <- pprLlvmCmmDecl decl + renderLlvm (hdoc $$ empty) (sdoc $$ empty) + ) cmmLlvmGen _ = return () @@ -204,7 +210,8 @@ cmmMetaLlvmPrelude = do -- name. Nothing -> [ MetaStr name ] cfg <- getConfig - renderLlvm $ ppLlvmMetas cfg metas + renderLlvm (ppLlvmMetas cfg metas) + (ppLlvmMetas cfg metas) -- ----------------------------------------------------------------------------- -- | Marks variables as used where necessary @@ -229,4 +236,7 @@ cmmUsedLlvmGens = do lmUsed = LMGlobal lmUsedVar (Just usedArray) if null ivars then return () - else getConfig >>= renderLlvm . flip pprLlvmData ([lmUsed], []) + else do + cfg <- getConfig + renderLlvm (pprLlvmData cfg ([lmUsed], [])) + (pprLlvmData cfg ([lmUsed], [])) ===================================== compiler/GHC/CmmToLlvm/Base.hs ===================================== @@ -371,13 +371,13 @@ dumpIfSetLlvm flag hdr fmt doc = do liftIO $ putDumpFileMaybe logger flag hdr fmt doc -- | Prints the given contents to the output handle -renderLlvm :: Outp.SDoc -> LlvmM () -renderLlvm sdoc = do +renderLlvm :: Outp.HDoc -> Outp.SDoc -> LlvmM () +renderLlvm hdoc sdoc = do -- Write to output ctx <- llvmCgContext <$> getConfig out <- getEnv envOutput - liftIO $ Outp.bufLeftRenderSDoc ctx out sdoc + liftIO $ Outp.bPutHDoc out ctx hdoc -- Dump, if requested dumpIfSetLlvm Opt_D_dump_llvm "LLVM Code" FormatLLVM sdoc @@ -428,7 +428,7 @@ ghcInternalFunctions = do let n' = fsLit n decl = LlvmFunctionDecl n' ExternallyVisible CC_Ccc ret FixedArgs (tysToParams args) Nothing - renderLlvm $ ppLlvmFunctionDecl decl + renderLlvm (ppLlvmFunctionDecl decl) (ppLlvmFunctionDecl decl) funInsert n' (LMFunction decl) -- ---------------------------------------------------------------------------- ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -207,7 +207,7 @@ genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do castV <- lift $ mkLocalVar ty ve <- exprToVarW e statement $ Assignment castV $ Cast LM_Uitofp ve width - statement $ Store castV dstV Nothing + statement $ Store castV dstV Nothing [] genCall (PrimTarget (MO_UF_Conv _)) [_] args = panic $ "genCall: Too many arguments to MO_UF_Conv. " ++ @@ -263,12 +263,12 @@ genCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = runStmtsDecls $ AMO_Or -> LAO_Or AMO_Xor -> LAO_Xor retVar <- doExprW targetTy $ AtomicRMW op ptrVar nVar SyncSeqCst - statement $ Store retVar dstVar Nothing + statement $ Store retVar dstVar Nothing [] genCall (PrimTarget (MO_AtomicRead _ mem_ord)) [dst] [addr] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) v1 <- genLoadW (Just mem_ord) addr (localRegType dst) NaturallyAligned - statement $ Store v1 dstV Nothing + statement $ Store v1 dstV Nothing [] genCall (PrimTarget (MO_Cmpxchg _width)) [dst] [addr, old, new] = runStmtsDecls $ do @@ -282,7 +282,7 @@ genCall (PrimTarget (MO_Cmpxchg _width)) retVar <- doExprW (LMStructU [targetTy,i1]) $ CmpXChg ptrVar oldVar newVar SyncSeqCst SyncSeqCst retVar' <- doExprW targetTy $ ExtractV retVar 0 - statement $ Store retVar' dstVar Nothing + statement $ Store retVar' dstVar Nothing [] genCall (PrimTarget (MO_Xchg _width)) [dst] [addr, val] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) :: WriterT LlvmAccum LlvmM LlvmVar @@ -292,7 +292,7 @@ genCall (PrimTarget (MO_Xchg _width)) [dst] [addr, val] = runStmtsDecls $ do ptrExpr = Cast LM_Inttoptr addrVar ptrTy ptrVar <- doExprW ptrTy ptrExpr resVar <- doExprW (getVarType valVar) (AtomicRMW LAO_Xchg ptrVar valVar SyncSeqCst) - statement $ Store resVar dstV Nothing + statement $ Store resVar dstV Nothing [] genCall (PrimTarget (MO_AtomicWrite _width mem_ord)) [] [addr, val] = runStmtsDecls $ do addrVar <- exprToVarW addr @@ -353,8 +353,8 @@ genCall (PrimTarget (MO_U_Mul2 w)) [dstH, dstL] [lhs, rhs] = runStmtsDecls $ do retH <- doExprW width $ Cast LM_Trunc retShifted width dstRegL <- getCmmRegW (CmmLocal dstL) dstRegH <- getCmmRegW (CmmLocal dstH) - statement $ Store retL dstRegL Nothing - statement $ Store retH dstRegH Nothing + statement $ Store retL dstRegL Nothing [] + statement $ Store retH dstRegH Nothing [] genCall (PrimTarget (MO_S_Mul2 w)) [dstC, dstH, dstL] [lhs, rhs] = runStmtsDecls $ do let width = widthToLlvmInt w @@ -385,9 +385,9 @@ genCall (PrimTarget (MO_S_Mul2 w)) [dstC, dstH, dstL] [lhs, rhs] = runStmtsDecls dstRegL <- getCmmRegW (CmmLocal dstL) dstRegH <- getCmmRegW (CmmLocal dstH) dstRegC <- getCmmRegW (CmmLocal dstC) - statement $ Store retL dstRegL Nothing - statement $ Store retH dstRegH Nothing - statement $ Store retC dstRegC Nothing + statement $ Store retL dstRegL Nothing [] + statement $ Store retH dstRegH Nothing [] + statement $ Store retC dstRegC Nothing [] -- MO_U_QuotRem2 is another case we handle by widening the registers to double -- the width and use normal LLVM instructions (similarly to the MO_U_Mul2). The @@ -421,8 +421,8 @@ genCall (PrimTarget (MO_U_QuotRem2 w)) retRem <- narrow retExtRem dstRegQ <- lift $ getCmmReg (CmmLocal dstQ) dstRegR <- lift $ getCmmReg (CmmLocal dstR) - statement $ Store retDiv dstRegQ Nothing - statement $ Store retRem dstRegR Nothing + statement $ Store retDiv dstRegQ Nothing [] + statement $ Store retRem dstRegR Nothing [] -- Handle the MO_{Add,Sub}IntC separately. LLVM versions return a record from -- which we need to extract the actual values. @@ -529,7 +529,7 @@ genCall target res args = do vreg <- getCmmRegW (CmmLocal creg) if retTy == pLower (getVarType vreg) then do - statement $ Store v1 vreg Nothing + statement $ Store v1 vreg Nothing [] doReturn else do let ty = pLower $ getVarType vreg @@ -541,7 +541,7 @@ genCall target res args = do ++ " returned type!" v2 <- doExprW ty $ Cast op v1 ty - statement $ Store v2 vreg Nothing + statement $ Store v2 vreg Nothing [] doReturn -- | Generate a call to an LLVM intrinsic that performs arithmetic operation @@ -570,8 +570,8 @@ genCallWithOverflow t@(PrimTarget op) w [dstV, dstO] [lhs, rhs] = do (overflow, zext) <- doExpr width $ Cast LM_Zext overflowBit width dstRegV <- getCmmReg (CmmLocal dstV) dstRegO <- getCmmReg (CmmLocal dstO) - let storeV = Store value dstRegV Nothing - storeO = Store overflow dstRegO Nothing + let storeV = Store value dstRegV Nothing [] + storeO = Store overflow dstRegO Nothing [] return (stmts `snocOL` zext `snocOL` storeV `snocOL` storeO, top) genCallWithOverflow _ _ _ _ = panic "genCallExtract: wrong ForeignTarget or number of arguments" @@ -636,7 +636,7 @@ genCallSimpleCast w t@(PrimTarget op) [dst] args = do (retV, s1) <- doExpr width $ Call StdCall fptr argsV' [] (retVs', stmts5) <- castVars (cmmPrimOpRetValSignage op) [(retV,dstTy)] let retV' = singletonPanic "genCallSimpleCast" retVs' - let s2 = Store retV' dstV Nothing + let s2 = Store retV' dstV Nothing [] let stmts = stmts2 `appOL` stmts4 `snocOL` s1 `appOL` stmts5 `snocOL` s2 @@ -668,7 +668,7 @@ genCallSimpleCast2 w t@(PrimTarget op) [dst] args = do (retV, s1) <- doExpr width $ Call StdCall fptr argsV' [] (retVs', stmts5) <- castVars (cmmPrimOpRetValSignage op) [(retV,dstTy)] let retV' = singletonPanic "genCallSimpleCast2" retVs' - let s2 = Store retV' dstV Nothing + let s2 = Store retV' dstV Nothing [] let stmts = stmts2 `appOL` stmts4 `snocOL` s1 `appOL` stmts5 `snocOL` s2 @@ -1098,16 +1098,16 @@ genAssign reg val = do -- Some registers are pointer types, so need to cast value to pointer LMPointer _ | getVarType vval == llvmWord platform -> do (v, s1) <- doExpr ty $ Cast LM_Inttoptr vval ty - let s2 = Store v vreg Nothing + let s2 = Store v vreg Nothing [] return (stmts `snocOL` s1 `snocOL` s2, top2) LMVector _ _ -> do (v, s1) <- doExpr ty $ Cast LM_Bitcast vval ty - let s2 = mkStore v vreg NaturallyAligned + let s2 = mkStore v vreg NaturallyAligned [] return (stmts `snocOL` s1 `snocOL` s2, top2) _ -> do - let s1 = Store vval vreg Nothing + let s1 = Store vval vreg Nothing [] return (stmts `snocOL` s1, top2) @@ -1158,7 +1158,7 @@ genStore_fast addr r n val alignment case pLower grt == getVarType vval of -- were fine True -> do - let s3 = MetaStmt meta $ mkStore vval ptr alignment + let s3 = mkStore vval ptr alignment meta return (stmts `appOL` s1 `snocOL` s2 `snocOL` s3, top) @@ -1166,7 +1166,7 @@ genStore_fast addr r n val alignment False -> do let ty = (pLift . getVarType) vval (ptr', s3) <- doExpr ty $ Cast LM_Bitcast ptr ty - let s4 = MetaStmt meta $ mkStore vval ptr' alignment + let s4 = mkStore vval ptr' alignment meta return (stmts `appOL` s1 `snocOL` s2 `snocOL` s3 `snocOL` s4, top) @@ -1189,17 +1189,17 @@ genStore_slow addr val alignment meta = do -- sometimes we need to cast an int to a pointer before storing LMPointer ty@(LMPointer _) | getVarType vval == llvmWord platform -> do (v, s1) <- doExpr ty $ Cast LM_Inttoptr vval ty - let s2 = MetaStmt meta $ mkStore v vaddr alignment + let s2 = mkStore v vaddr alignment meta return (stmts `snocOL` s1 `snocOL` s2, top1 ++ top2) LMPointer _ -> do - let s1 = MetaStmt meta $ mkStore vval vaddr alignment + let s1 = mkStore vval vaddr alignment meta return (stmts `snocOL` s1, top1 ++ top2) i@(LMInt _) | i == llvmWord platform -> do let vty = pLift $ getVarType vval (vptr, s1) <- doExpr vty $ Cast LM_Inttoptr vaddr vty - let s2 = MetaStmt meta $ mkStore vval vptr alignment + let s2 = mkStore vval vptr alignment meta return (stmts `snocOL` s1 `snocOL` s2, top1 ++ top2) other -> @@ -1209,9 +1209,9 @@ genStore_slow addr val alignment meta = do text "Size of var:" <+> ppr (llvmWidthInBits platform other) $$ text "Var:" <+> ppVar cfg vaddr) -mkStore :: LlvmVar -> LlvmVar -> AlignmentSpec -> LlvmStatement -mkStore vval vptr alignment = - Store vval vptr align +mkStore :: LlvmVar -> LlvmVar -> AlignmentSpec -> [MetaAnnot] -> LlvmStatement +mkStore vval vptr alignment metas = + Store vval vptr align metas where ty = pLower (getVarType vptr) align = case alignment of @@ -2072,7 +2072,7 @@ funPrologue live cmmBlocks = do rval = if isLive r then arg else trash alloc = Assignment reg $ Alloca (pLower $ getVarType reg) 1 markStackReg r - return $ toOL [alloc, Store rval reg Nothing] + return $ toOL [alloc, Store rval reg Nothing []] return (concatOL stmtss `snocOL` jumpToEntry, []) where ===================================== compiler/GHC/CmmToLlvm/Ppr.hs ===================================== @@ -26,22 +26,28 @@ import GHC.Types.Unique -- -- | Pretty print LLVM data code -pprLlvmData :: LlvmCgConfig -> LlvmData -> SDoc +pprLlvmData :: IsDoc doc => LlvmCgConfig -> LlvmData -> doc pprLlvmData cfg (globals, types) = - let ppLlvmTys (LMAlias a) = ppLlvmAlias a + let ppLlvmTys (LMAlias a) = line $ ppLlvmAlias a ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f ppLlvmTys _other = empty types' = vcat $ map ppLlvmTys types globals' = ppLlvmGlobals cfg globals - in types' $+$ globals' + in types' $$ globals' +{-# SPECIALIZE pprLlvmData :: LlvmCgConfig -> LlvmData -> SDoc #-} +{-# SPECIALIZE pprLlvmData :: LlvmCgConfig -> LlvmData -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Pretty print LLVM code -pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar]) +-- The HDoc we return is used to produce the final LLVM file, with the +-- SDoc being returned alongside for use when @Opt_D_dump_llvm@ is set +-- as we can't (currently) dump HDocs. +pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (HDoc, SDoc) pprLlvmCmmDecl (CmmData _ lmdata) = do opts <- getConfig - return (vcat $ map (pprLlvmData opts) lmdata, []) + return ( vcat $ map (pprLlvmData opts) lmdata + , vcat $ map (pprLlvmData opts) lmdata) pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks)) = do let lbl = case mb_info of @@ -92,7 +98,8 @@ pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks)) (Just $ LMBitc (LMStaticPointer defVar) i8Ptr) - return (ppLlvmGlobal cfg alias $+$ ppLlvmFunction cfg fun', []) + return ( vcat [line $ ppLlvmGlobal cfg alias, ppLlvmFunction cfg fun'] + , vcat [line $ ppLlvmGlobal cfg alias, ppLlvmFunction cfg fun']) -- | The section we are putting info tables and their entry code into, should ===================================== compiler/GHC/Llvm/MetaData.hs ===================================== @@ -64,7 +64,12 @@ newtype MetaId = MetaId Int deriving (Eq, Ord, Enum) instance Outputable MetaId where - ppr (MetaId n) = char '!' <> int n + ppr = ppMetaId + +ppMetaId :: IsLine doc => MetaId -> doc +ppMetaId (MetaId n) = char '!' <> int n +{-# SPECIALIZE ppMetaId :: MetaId -> SDoc #-} +{-# SPECIALIZE ppMetaId :: MetaId -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | LLVM metadata expressions data MetaExpr = MetaStr !LMString ===================================== compiler/GHC/Llvm/Ppr.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} -------------------------------------------------------------------------------- -- | Pretty print LLVM IR Code. @@ -36,7 +37,6 @@ import GHC.Llvm.Syntax import GHC.Llvm.MetaData import GHC.Llvm.Types -import Data.Int import Data.List ( intersperse ) import GHC.Utils.Outputable @@ -49,30 +49,39 @@ import GHC.Types.Unique -------------------------------------------------------------------------------- -- | Print out a whole LLVM module. -ppLlvmModule :: LlvmCgConfig -> LlvmModule -> SDoc +ppLlvmModule :: IsDoc doc => LlvmCgConfig -> LlvmModule -> doc ppLlvmModule opts (LlvmModule comments aliases meta globals decls funcs) - = ppLlvmComments comments $+$ newLine - $+$ ppLlvmAliases aliases $+$ newLine - $+$ ppLlvmMetas opts meta $+$ newLine - $+$ ppLlvmGlobals opts globals $+$ newLine - $+$ ppLlvmFunctionDecls decls $+$ newLine - $+$ ppLlvmFunctions opts funcs + = ppLlvmComments comments $$ newLine + $$ ppLlvmAliases aliases $$ newLine + $$ ppLlvmMetas opts meta $$ newLine + $$ ppLlvmGlobals opts globals $$ newLine + $$ ppLlvmFunctionDecls decls $$ newLine + $$ ppLlvmFunctions opts funcs +{-# SPECIALIZE ppLlvmModule :: LlvmCgConfig -> LlvmModule -> SDoc #-} +{-# SPECIALIZE ppLlvmModule :: LlvmCgConfig -> LlvmModule -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable + -- | Print out a multi-line comment, can be inside a function or on its own -ppLlvmComments :: [LMString] -> SDoc -ppLlvmComments comments = vcat $ map ppLlvmComment comments +ppLlvmComments :: IsDoc doc => [LMString] -> doc +ppLlvmComments comments = lines_ $ map ppLlvmComment comments +{-# SPECIALIZE ppLlvmComments :: [LMString] -> SDoc #-} +{-# SPECIALIZE ppLlvmComments :: [LMString] -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out a comment, can be inside a function or on its own -ppLlvmComment :: LMString -> SDoc +ppLlvmComment :: IsLine doc => LMString -> doc ppLlvmComment com = semi <+> ftext com +{-# SPECIALIZE ppLlvmComment :: LMString -> SDoc #-} +{-# SPECIALIZE ppLlvmComment :: LMString -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out a list of global mutable variable definitions -ppLlvmGlobals :: LlvmCgConfig -> [LMGlobal] -> SDoc -ppLlvmGlobals opts ls = vcat $ map (ppLlvmGlobal opts) ls +ppLlvmGlobals :: IsDoc doc => LlvmCgConfig -> [LMGlobal] -> doc +ppLlvmGlobals opts ls = lines_ $ map (ppLlvmGlobal opts) ls +{-# SPECIALIZE ppLlvmGlobals :: LlvmCgConfig -> [LMGlobal] -> SDoc #-} +{-# SPECIALIZE ppLlvmGlobals :: LlvmCgConfig -> [LMGlobal] -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out a global mutable variable definition -ppLlvmGlobal :: LlvmCgConfig -> LMGlobal -> SDoc +ppLlvmGlobal :: IsLine doc => LlvmCgConfig -> LMGlobal -> doc ppLlvmGlobal opts (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) = let sect = case x of Just x' -> text ", section" <+> doubleQuotes (ftext x') @@ -84,7 +93,7 @@ ppLlvmGlobal opts (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) = rhs = case dat of Just stat -> pprSpecialStatic opts stat - Nothing -> ppr (pLower $ getVarType var) + Nothing -> ppLlvmType (pLower $ getVarType var) -- Position of linkage is different for aliases. const = case c of @@ -92,105 +101,130 @@ ppLlvmGlobal opts (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) = Constant -> "constant" Alias -> "alias" - in ppAssignment opts var $ ppr link <+> text const <+> rhs <> sect <> align - $+$ newLine + in ppAssignment opts var $ ppLlvmLinkageType link <+> text const <+> rhs <> sect <> align ppLlvmGlobal opts (LMGlobal var val) = pprPanic "ppLlvmGlobal" $ - text "Non Global var ppr as global! " <> ppVar opts var <> text "=" <> ppr (fmap (ppStatic opts) val) + text "Non Global var ppr as global! " <> ppVar opts var <> text "=" <> ppr (fmap (ppStatic @SDoc opts) val) +{-# SPECIALIZE ppLlvmGlobal :: LlvmCgConfig -> LMGlobal -> SDoc #-} +{-# SPECIALIZE ppLlvmGlobal :: LlvmCgConfig -> LMGlobal -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out a list of LLVM type aliases. -ppLlvmAliases :: [LlvmAlias] -> SDoc -ppLlvmAliases tys = vcat $ map ppLlvmAlias tys +ppLlvmAliases :: IsDoc doc => [LlvmAlias] -> doc +ppLlvmAliases tys = lines_ $ map ppLlvmAlias tys +{-# SPECIALIZE ppLlvmAliases :: [LlvmAlias] -> SDoc #-} +{-# SPECIALIZE ppLlvmAliases :: [LlvmAlias] -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out an LLVM type alias. -ppLlvmAlias :: LlvmAlias -> SDoc +ppLlvmAlias :: IsLine doc => LlvmAlias -> doc ppLlvmAlias (name, ty) - = char '%' <> ftext name <+> equals <+> text "type" <+> ppr ty + = char '%' <> ftext name <+> equals <+> text "type" <+> ppLlvmType ty +{-# SPECIALIZE ppLlvmAlias :: LlvmAlias -> SDoc #-} +{-# SPECIALIZE ppLlvmAlias :: LlvmAlias -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out a list of LLVM metadata. -ppLlvmMetas :: LlvmCgConfig -> [MetaDecl] -> SDoc -ppLlvmMetas opts metas = vcat $ map (ppLlvmMeta opts) metas +ppLlvmMetas :: IsDoc doc => LlvmCgConfig -> [MetaDecl] -> doc +ppLlvmMetas opts metas = lines_ $ map (ppLlvmMeta opts) metas +{-# SPECIALIZE ppLlvmMetas :: LlvmCgConfig -> [MetaDecl] -> SDoc #-} +{-# SPECIALIZE ppLlvmMetas :: LlvmCgConfig -> [MetaDecl] -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out an LLVM metadata definition. -ppLlvmMeta :: LlvmCgConfig -> MetaDecl -> SDoc +ppLlvmMeta :: IsLine doc => LlvmCgConfig -> MetaDecl -> doc ppLlvmMeta opts (MetaUnnamed n m) - = ppr n <+> equals <+> ppMetaExpr opts m + = ppMetaId n <+> equals <+> ppMetaExpr opts m ppLlvmMeta _opts (MetaNamed n m) = exclamation <> ftext n <+> equals <+> exclamation <> braces nodes where - nodes = hcat $ intersperse comma $ map ppr m + nodes = hcat $ intersperse comma $ map ppMetaId m +{-# SPECIALIZE ppLlvmMeta :: LlvmCgConfig -> MetaDecl -> SDoc #-} +{-# SPECIALIZE ppLlvmMeta :: LlvmCgConfig -> MetaDecl -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out a list of function definitions. -ppLlvmFunctions :: LlvmCgConfig -> LlvmFunctions -> SDoc +ppLlvmFunctions :: IsDoc doc => LlvmCgConfig -> LlvmFunctions -> doc ppLlvmFunctions opts funcs = vcat $ map (ppLlvmFunction opts) funcs +{-# SPECIALIZE ppLlvmFunctions :: LlvmCgConfig -> LlvmFunctions -> SDoc #-} +{-# SPECIALIZE ppLlvmFunctions :: LlvmCgConfig -> LlvmFunctions -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out a function definition. -ppLlvmFunction :: LlvmCgConfig -> LlvmFunction -> SDoc +ppLlvmFunction :: IsDoc doc => LlvmCgConfig -> LlvmFunction -> doc ppLlvmFunction opts fun = - let attrDoc = ppSpaceJoin (funcAttrs fun) + let attrDoc = ppSpaceJoin ppLlvmFuncAttr (funcAttrs fun) secDoc = case funcSect fun of Just s' -> text "section" <+> (doubleQuotes $ ftext s') Nothing -> empty prefixDoc = case funcPrefix fun of Just v -> text "prefix" <+> ppStatic opts v Nothing -> empty - in text "define" <+> ppLlvmFunctionHeader (funcDecl fun) (funcArgs fun) - <+> attrDoc <+> secDoc <+> prefixDoc - $+$ lbrace - $+$ ppLlvmBlocks opts (funcBody fun) - $+$ rbrace - $+$ newLine - $+$ newLine + in vcat + [line $ text "define" <+> ppLlvmFunctionHeader (funcDecl fun) (funcArgs fun) + <+> attrDoc <+> secDoc <+> prefixDoc + , line lbrace + , ppLlvmBlocks opts (funcBody fun) + , line rbrace + , newLine + , newLine] +{-# SPECIALIZE ppLlvmFunction :: LlvmCgConfig -> LlvmFunction -> SDoc #-} +{-# SPECIALIZE ppLlvmFunction :: LlvmCgConfig -> LlvmFunction -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out a function definition header. -ppLlvmFunctionHeader :: LlvmFunctionDecl -> [LMString] -> SDoc +ppLlvmFunctionHeader :: IsLine doc => LlvmFunctionDecl -> [LMString] -> doc ppLlvmFunctionHeader (LlvmFunctionDecl n l c r varg p a) args = let varg' = case varg of VarArgs | null p -> text "..." | otherwise -> text ", ..." _otherwise -> text "" align = case a of - Just a' -> text " align " <> ppr a' + Just a' -> text " align " <> int a' Nothing -> empty - args' = map (\((ty,p),n) -> ppr ty <+> ppSpaceJoin p <+> char '%' + args' = zipWith (\(ty,p) n -> ppLlvmType ty <+> ppSpaceJoin ppLlvmParamAttr p <+> char '%' <> ftext n) - (zip p args) - in ppr l <+> ppr c <+> ppr r <+> char '@' <> ftext n <> lparen <> - (hsep $ punctuate comma args') <> varg' <> rparen <> align + p + args + in ppLlvmLinkageType l <+> ppLlvmCallConvention c <+> ppLlvmType r <+> char '@' <> ftext n <> lparen <> + hsep (punctuate comma args') <> varg' <> rparen <> align +{-# SPECIALIZE ppLlvmFunctionHeader :: LlvmFunctionDecl -> [LMString] -> SDoc #-} +{-# SPECIALIZE ppLlvmFunctionHeader :: LlvmFunctionDecl -> [LMString] -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out a list of function declaration. -ppLlvmFunctionDecls :: LlvmFunctionDecls -> SDoc +ppLlvmFunctionDecls :: IsDoc doc => LlvmFunctionDecls -> doc ppLlvmFunctionDecls decs = vcat $ map ppLlvmFunctionDecl decs +{-# SPECIALIZE ppLlvmFunctionDecls :: LlvmFunctionDecls -> SDoc #-} +{-# SPECIALIZE ppLlvmFunctionDecls :: LlvmFunctionDecls -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out a function declaration. -- Declarations define the function type but don't define the actual body of -- the function. -ppLlvmFunctionDecl :: LlvmFunctionDecl -> SDoc +ppLlvmFunctionDecl :: IsDoc doc => LlvmFunctionDecl -> doc ppLlvmFunctionDecl (LlvmFunctionDecl n l c r varg p a) = let varg' = case varg of VarArgs | null p -> text "..." | otherwise -> text ", ..." _otherwise -> text "" align = case a of - Just a' -> text " align" <+> ppr a' + Just a' -> text " align" <+> int a' Nothing -> empty args = hcat $ intersperse (comma <> space) $ - map (\(t,a) -> ppr t <+> ppSpaceJoin a) p - in text "declare" <+> ppr l <+> ppr c <+> ppr r <+> char '@' <> - ftext n <> lparen <> args <> varg' <> rparen <> align $+$ newLine + map (\(t,a) -> ppLlvmType t <+> ppSpaceJoin ppLlvmParamAttr a) p + in lines_ + [ text "declare" <+> ppLlvmLinkageType l <+> ppLlvmCallConvention c + <+> ppLlvmType r <+> char '@' <> ftext n <> lparen <> args <> varg' <> rparen <> align + , empty] +{-# SPECIALIZE ppLlvmFunctionDecl :: LlvmFunctionDecl -> SDoc #-} +{-# SPECIALIZE ppLlvmFunctionDecl :: LlvmFunctionDecl -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out a list of LLVM blocks. -ppLlvmBlocks :: LlvmCgConfig -> LlvmBlocks -> SDoc +ppLlvmBlocks :: IsDoc doc => LlvmCgConfig -> LlvmBlocks -> doc ppLlvmBlocks opts blocks = vcat $ map (ppLlvmBlock opts) blocks +{-# SPECIALIZE ppLlvmBlocks :: LlvmCgConfig -> LlvmBlocks -> SDoc #-} +{-# SPECIALIZE ppLlvmBlocks :: LlvmCgConfig -> LlvmBlocks -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out an LLVM block. -- It must be part of a function definition. -ppLlvmBlock :: LlvmCgConfig -> LlvmBlock -> SDoc +ppLlvmBlock :: IsDoc doc => LlvmCgConfig -> LlvmBlock -> doc ppLlvmBlock opts (LlvmBlock blockId stmts) = let isLabel (MkLabel _) = True isLabel _ = False @@ -198,39 +232,44 @@ ppLlvmBlock opts (LlvmBlock blockId stmts) = ppRest = case rest of MkLabel id:xs -> ppLlvmBlock opts (LlvmBlock id xs) _ -> empty - in ppLlvmBlockLabel blockId - $+$ (vcat $ map (ppLlvmStatement opts) block) - $+$ newLine - $+$ ppRest + in vcat $ + line (ppLlvmBlockLabel blockId) + : map (ppLlvmStatement opts) block + ++ [ empty , ppRest ] +{-# SPECIALIZE ppLlvmBlock :: LlvmCgConfig -> LlvmBlock -> SDoc #-} +{-# SPECIALIZE ppLlvmBlock :: LlvmCgConfig -> LlvmBlock -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out an LLVM block label. -ppLlvmBlockLabel :: LlvmBlockId -> SDoc +ppLlvmBlockLabel :: IsLine doc => LlvmBlockId -> doc ppLlvmBlockLabel id = pprUniqueAlways id <> colon +{-# SPECIALIZE ppLlvmBlockLabel :: LlvmBlockId -> SDoc #-} +{-# SPECIALIZE ppLlvmBlockLabel :: LlvmBlockId -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable --- | Print out an LLVM statement. -ppLlvmStatement :: LlvmCgConfig -> LlvmStatement -> SDoc +-- | Print out an LLVM statement, with any metadata to append to the statement. +ppLlvmStatement :: IsDoc doc => LlvmCgConfig -> LlvmStatement -> doc ppLlvmStatement opts stmt = - let ind = (text " " <>) + let ind = line . (text " " <>) in case stmt of Assignment dst expr -> ind $ ppAssignment opts dst (ppLlvmExpression opts expr) Fence st ord -> ind $ ppFence st ord Branch target -> ind $ ppBranch opts target BranchIf cond ifT ifF -> ind $ ppBranchIf opts cond ifT ifF - Comment comments -> ind $ ppLlvmComments comments - MkLabel label -> ppLlvmBlockLabel label - Store value ptr align - -> ind $ ppStore opts value ptr align - Switch scrut def tgs -> ind $ ppSwitch opts scrut def tgs + Comment comments -> ppLlvmComments comments + MkLabel label -> line $ ppLlvmBlockLabel label + Store value ptr align metas + -> ind $ ppStore opts value ptr align metas + Switch scrut def tgs -> ppSwitch opts scrut def tgs Return result -> ind $ ppReturn opts result Expr expr -> ind $ ppLlvmExpression opts expr Unreachable -> ind $ text "unreachable" - Nop -> empty - MetaStmt meta s -> ppMetaStatement opts meta s + Nop -> line empty +{-# SPECIALIZE ppLlvmStatement :: LlvmCgConfig -> LlvmStatement -> SDoc #-} +{-# SPECIALIZE ppLlvmStatement :: LlvmCgConfig -> LlvmStatement -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print out an LLVM expression. -ppLlvmExpression :: LlvmCgConfig -> LlvmExpression -> SDoc +ppLlvmExpression :: IsLine doc => LlvmCgConfig -> LlvmExpression -> doc ppLlvmExpression opts expr = case expr of Alloca tp amount -> ppAlloca opts tp amount @@ -251,14 +290,18 @@ ppLlvmExpression opts expr Phi tp predecessors -> ppPhi opts tp predecessors Asm asm c ty v se sk -> ppAsm opts asm c ty v se sk MExpr meta expr -> ppMetaAnnotExpr opts meta expr +{-# SPECIALIZE ppLlvmExpression :: LlvmCgConfig -> LlvmExpression -> SDoc #-} +{-# SPECIALIZE ppLlvmExpression :: LlvmCgConfig -> LlvmExpression -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppMetaExpr :: LlvmCgConfig -> MetaExpr -> SDoc +ppMetaExpr :: IsLine doc => LlvmCgConfig -> MetaExpr -> doc ppMetaExpr opts = \case MetaVar (LMLitVar (LMNullLit _)) -> text "null" MetaStr s -> char '!' <> doubleQuotes (ftext s) - MetaNode n -> ppr n + MetaNode n -> ppMetaId n MetaVar v -> ppVar opts v - MetaStruct es -> char '!' <> braces (ppCommaJoin (map (ppMetaExpr opts) es)) + MetaStruct es -> char '!' <> braces (ppCommaJoin (ppMetaExpr opts) es) +{-# SPECIALIZE ppMetaExpr :: LlvmCgConfig -> MetaExpr -> SDoc #-} +{-# SPECIALIZE ppMetaExpr :: LlvmCgConfig -> MetaExpr -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -------------------------------------------------------------------------------- @@ -267,7 +310,8 @@ ppMetaExpr opts = \case -- | Should always be a function pointer. So a global var of function type -- (since globals are always pointers) or a local var of pointer function type. -ppCall :: LlvmCgConfig -> LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc +ppCall :: forall doc. IsLine doc => LlvmCgConfig -> LlvmCallType -> LlvmVar -> [MetaExpr] + -> [LlvmFuncAttr] -> doc ppCall opts ct fptr args attrs = case fptr of -- -- if local var function pointer, unwrap @@ -285,32 +329,36 @@ ppCall opts ct fptr args attrs = case fptr of ppCall' (LlvmFunctionDecl _ _ cc ret argTy params _) = let tc = if ct == TailCall then text "tail " else empty ppValues = ppCallParams opts (map snd params) args - ppArgTy = (ppCommaJoin $ map (ppr . fst) params) <> + ppArgTy = ppCommaJoin (ppLlvmType . fst) params <> (case argTy of VarArgs -> text ", ..." FixedArgs -> empty) fnty = space <> lparen <> ppArgTy <> rparen - attrDoc = ppSpaceJoin attrs - in tc <> text "call" <+> ppr cc <+> ppr ret + attrDoc = ppSpaceJoin ppLlvmFuncAttr attrs + in tc <> text "call" <+> ppLlvmCallConvention cc <+> ppLlvmType ret <> fnty <+> ppName opts fptr <> lparen <+> ppValues <+> rparen <+> attrDoc - ppCallParams :: LlvmCgConfig -> [[LlvmParamAttr]] -> [MetaExpr] -> SDoc + ppCallParams :: LlvmCgConfig -> [[LlvmParamAttr]] -> [MetaExpr] -> doc ppCallParams opts attrs args = hsep $ punctuate comma $ zipWith ppCallMetaExpr attrs args where -- Metadata needs to be marked as having the `metadata` type when used -- in a call argument ppCallMetaExpr attrs (MetaVar v) = ppVar' attrs opts v ppCallMetaExpr _ v = text "metadata" <+> ppMetaExpr opts v +{-# SPECIALIZE ppCall :: LlvmCgConfig -> LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc #-} +{-# SPECIALIZE ppCall :: LlvmCgConfig -> LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppMachOp :: LlvmCgConfig -> LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc +ppMachOp :: IsLine doc => LlvmCgConfig -> LlvmMachOp -> LlvmVar -> LlvmVar -> doc ppMachOp opts op left right = - (ppr op) <+> (ppr (getVarType left)) <+> ppName opts left + ppLlvmMachOp op <+> ppLlvmType (getVarType left) <+> ppName opts left <> comma <+> ppName opts right +{-# SPECIALIZE ppMachOp :: LlvmCgConfig -> LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc #-} +{-# SPECIALIZE ppMachOp :: LlvmCgConfig -> LlvmMachOp -> LlvmVar -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppCmpOp :: LlvmCgConfig -> LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc +ppCmpOp :: IsLine doc => LlvmCgConfig -> LlvmCmpOp -> LlvmVar -> LlvmVar -> doc ppCmpOp opts op left right = let cmpOp | isInt (getVarType left) && isInt (getVarType right) = text "icmp" @@ -321,28 +369,36 @@ ppCmpOp opts op left right = ++ (show $ getVarType left) ++ ", right = " ++ (show $ getVarType right)) -} - in cmpOp <+> ppr op <+> ppr (getVarType left) + in cmpOp <+> ppLlvmCmpOp op <+> ppLlvmType (getVarType left) <+> ppName opts left <> comma <+> ppName opts right +{-# SPECIALIZE ppCmpOp :: LlvmCgConfig -> LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc #-} +{-# SPECIALIZE ppCmpOp :: LlvmCgConfig -> LlvmCmpOp -> LlvmVar -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppAssignment :: LlvmCgConfig -> LlvmVar -> SDoc -> SDoc +ppAssignment :: IsLine doc => LlvmCgConfig -> LlvmVar -> doc -> doc ppAssignment opts var expr = ppName opts var <+> equals <+> expr +{-# SPECIALIZE ppAssignment :: LlvmCgConfig -> LlvmVar -> SDoc -> SDoc #-} +{-# SPECIALIZE ppAssignment :: LlvmCgConfig -> LlvmVar -> HLine -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppFence :: Bool -> LlvmSyncOrdering -> SDoc +ppFence :: IsLine doc => Bool -> LlvmSyncOrdering -> doc ppFence st ord = let singleThread = case st of True -> text "singlethread" False -> empty in text "fence" <+> singleThread <+> ppSyncOrdering ord +{-# SPECIALIZE ppFence :: Bool -> LlvmSyncOrdering -> SDoc #-} +{-# SPECIALIZE ppFence :: Bool -> LlvmSyncOrdering -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppSyncOrdering :: LlvmSyncOrdering -> SDoc +ppSyncOrdering :: IsLine doc => LlvmSyncOrdering -> doc ppSyncOrdering SyncUnord = text "unordered" ppSyncOrdering SyncMonotonic = text "monotonic" ppSyncOrdering SyncAcquire = text "acquire" ppSyncOrdering SyncRelease = text "release" ppSyncOrdering SyncAcqRel = text "acq_rel" ppSyncOrdering SyncSeqCst = text "seq_cst" +{-# SPECIALIZE ppSyncOrdering :: LlvmSyncOrdering -> SDoc #-} +{-# SPECIALIZE ppSyncOrdering :: LlvmSyncOrdering -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppAtomicOp :: LlvmAtomicOp -> SDoc +ppAtomicOp :: IsLine doc => LlvmAtomicOp -> doc ppAtomicOp LAO_Xchg = text "xchg" ppAtomicOp LAO_Add = text "add" ppAtomicOp LAO_Sub = text "sub" @@ -354,184 +410,222 @@ ppAtomicOp LAO_Max = text "max" ppAtomicOp LAO_Min = text "min" ppAtomicOp LAO_Umax = text "umax" ppAtomicOp LAO_Umin = text "umin" +{-# SPECIALIZE ppAtomicOp :: LlvmAtomicOp -> SDoc #-} +{-# SPECIALIZE ppAtomicOp :: LlvmAtomicOp -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppAtomicRMW :: LlvmCgConfig -> LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> SDoc +ppAtomicRMW :: IsLine doc => LlvmCgConfig -> LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> doc ppAtomicRMW opts aop tgt src ordering = text "atomicrmw" <+> ppAtomicOp aop <+> ppVar opts tgt <> comma <+> ppVar opts src <+> ppSyncOrdering ordering +{-# SPECIALIZE ppAtomicRMW :: LlvmCgConfig -> LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> SDoc #-} +{-# SPECIALIZE ppAtomicRMW :: LlvmCgConfig -> LlvmAtomicOp -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppCmpXChg :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar - -> LlvmSyncOrdering -> LlvmSyncOrdering -> SDoc +ppCmpXChg :: IsLine doc => LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar + -> LlvmSyncOrdering -> LlvmSyncOrdering -> doc ppCmpXChg opts addr old new s_ord f_ord = text "cmpxchg" <+> ppVar opts addr <> comma <+> ppVar opts old <> comma <+> ppVar opts new <+> ppSyncOrdering s_ord <+> ppSyncOrdering f_ord +{-# SPECIALIZE ppCmpXChg :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> LlvmSyncOrdering -> SDoc #-} +{-# SPECIALIZE ppCmpXChg :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> LlvmSyncOrdering -> LlvmSyncOrdering -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppLoad :: LlvmCgConfig -> LlvmVar -> LMAlign -> SDoc +ppLoad :: IsLine doc => LlvmCgConfig -> LlvmVar -> LMAlign -> doc ppLoad opts var alignment = - text "load" <+> ppr derefType <> comma <+> ppVar opts var <> align + text "load" <+> ppLlvmType derefType <> comma <+> ppVar opts var <> align where derefType = pLower $ getVarType var align = case alignment of - Just n -> text ", align" <+> ppr n + Just n -> text ", align" <+> int n Nothing -> empty +{-# SPECIALIZE ppLoad :: LlvmCgConfig -> LlvmVar -> LMAlign -> SDoc #-} +{-# SPECIALIZE ppLoad :: LlvmCgConfig -> LlvmVar -> LMAlign -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppALoad :: LlvmCgConfig -> LlvmSyncOrdering -> SingleThreaded -> LlvmVar -> SDoc +ppALoad :: IsLine doc => LlvmCgConfig -> LlvmSyncOrdering -> SingleThreaded -> LlvmVar -> doc ppALoad opts ord st var = let alignment = llvmWidthInBits (llvmCgPlatform opts) (getVarType var) `quot` 8 - align = text ", align" <+> ppr alignment + align = text ", align" <+> int alignment sThreaded | st = text " singlethread" | otherwise = empty derefType = pLower $ getVarType var - in text "load atomic" <+> ppr derefType <> comma <+> ppVar opts var <> sThreaded + in text "load atomic" <+> ppLlvmType derefType <> comma <+> ppVar opts var <> sThreaded <+> ppSyncOrdering ord <> align +{-# SPECIALIZE ppALoad :: LlvmCgConfig -> LlvmSyncOrdering -> SingleThreaded -> LlvmVar -> SDoc #-} +{-# SPECIALIZE ppALoad :: LlvmCgConfig -> LlvmSyncOrdering -> SingleThreaded -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppStore :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LMAlign -> SDoc -ppStore opts val dst alignment = - text "store" <+> ppVar opts val <> comma <+> ppVar opts dst <> align +ppStore :: IsLine doc => LlvmCgConfig -> LlvmVar -> LlvmVar -> LMAlign -> [MetaAnnot] -> doc +ppStore opts val dst alignment metas = + text "store" <+> ppVar opts val <> comma <+> ppVar opts dst <> align <+> ppMetaAnnots opts metas where align = case alignment of - Just n -> text ", align" <+> ppr n + Just n -> text ", align" <+> int n Nothing -> empty +{-# SPECIALIZE ppStore :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LMAlign -> [MetaAnnot] -> SDoc #-} +{-# SPECIALIZE ppStore :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LMAlign -> [MetaAnnot] -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppCast :: LlvmCgConfig -> LlvmCastOp -> LlvmVar -> LlvmType -> SDoc +ppCast :: IsLine doc => LlvmCgConfig -> LlvmCastOp -> LlvmVar -> LlvmType -> doc ppCast opts op from to - = ppr op - <+> ppr (getVarType from) <+> ppName opts from + = ppLlvmCastOp op + <+> ppLlvmType (getVarType from) <+> ppName opts from <+> text "to" - <+> ppr to + <+> ppLlvmType to +{-# SPECIALIZE ppCast :: LlvmCgConfig -> LlvmCastOp -> LlvmVar -> LlvmType -> SDoc #-} +{-# SPECIALIZE ppCast :: LlvmCgConfig -> LlvmCastOp -> LlvmVar -> LlvmType -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppMalloc :: LlvmCgConfig -> LlvmType -> Int -> SDoc +ppMalloc :: IsLine doc => LlvmCgConfig -> LlvmType -> Int -> doc ppMalloc opts tp amount = let amount' = LMLitVar $ LMIntLit (toInteger amount) i32 - in text "malloc" <+> ppr tp <> comma <+> ppVar opts amount' - + in text "malloc" <+> ppLlvmType tp <> comma <+> ppVar opts amount' +{-# SPECIALIZE ppMalloc :: LlvmCgConfig -> LlvmType -> Int -> SDoc #-} +{-# SPECIALIZE ppMalloc :: LlvmCgConfig -> LlvmType -> Int -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppAlloca :: LlvmCgConfig -> LlvmType -> Int -> SDoc +ppAlloca :: IsLine doc => LlvmCgConfig -> LlvmType -> Int -> doc ppAlloca opts tp amount = let amount' = LMLitVar $ LMIntLit (toInteger amount) i32 - in text "alloca" <+> ppr tp <> comma <+> ppVar opts amount' - + in text "alloca" <+> ppLlvmType tp <> comma <+> ppVar opts amount' +{-# SPECIALIZE ppAlloca :: LlvmCgConfig -> LlvmType -> Int -> SDoc #-} +{-# SPECIALIZE ppAlloca :: LlvmCgConfig -> LlvmType -> Int -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppGetElementPtr :: LlvmCgConfig -> Bool -> LlvmVar -> [LlvmVar] -> SDoc +ppGetElementPtr :: IsLine doc => LlvmCgConfig -> Bool -> LlvmVar -> [LlvmVar] -> doc ppGetElementPtr opts inb ptr idx = - let indexes = comma <+> ppCommaJoin (map (ppVar opts) idx) + let indexes = comma <+> ppCommaJoin (ppVar opts) idx inbound = if inb then text "inbounds" else empty derefType = pLower $ getVarType ptr - in text "getelementptr" <+> inbound <+> ppr derefType <> comma <+> ppVar opts ptr + in text "getelementptr" <+> inbound <+> ppLlvmType derefType <> comma <+> ppVar opts ptr <> indexes +{-# SPECIALIZE ppGetElementPtr :: LlvmCgConfig -> Bool -> LlvmVar -> [LlvmVar] -> SDoc #-} +{-# SPECIALIZE ppGetElementPtr :: LlvmCgConfig -> Bool -> LlvmVar -> [LlvmVar] -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppReturn :: LlvmCgConfig -> Maybe LlvmVar -> SDoc +ppReturn :: IsLine doc => LlvmCgConfig -> Maybe LlvmVar -> doc ppReturn opts (Just var) = text "ret" <+> ppVar opts var -ppReturn _ Nothing = text "ret" <+> ppr LMVoid +ppReturn _ Nothing = text "ret" <+> ppLlvmType LMVoid +{-# SPECIALIZE ppReturn :: LlvmCgConfig -> Maybe LlvmVar -> SDoc #-} +{-# SPECIALIZE ppReturn :: LlvmCgConfig -> Maybe LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable - -ppBranch :: LlvmCgConfig -> LlvmVar -> SDoc +ppBranch :: IsLine doc => LlvmCgConfig -> LlvmVar -> doc ppBranch opts var = text "br" <+> ppVar opts var +{-# SPECIALIZE ppBranch :: LlvmCgConfig -> LlvmVar -> SDoc #-} +{-# SPECIALIZE ppBranch :: LlvmCgConfig -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppBranchIf :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc +ppBranchIf :: IsLine doc => LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> doc ppBranchIf opts cond trueT falseT = text "br" <+> ppVar opts cond <> comma <+> ppVar opts trueT <> comma <+> ppVar opts falseT +{-# SPECIALIZE ppBranchIf :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc #-} +{-# SPECIALIZE ppBranchIf :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppPhi :: LlvmCgConfig -> LlvmType -> [(LlvmVar,LlvmVar)] -> SDoc +ppPhi :: IsLine doc => LlvmCgConfig -> LlvmType -> [(LlvmVar,LlvmVar)] -> doc ppPhi opts tp preds = let ppPreds (val, label) = brackets $ ppName opts val <> comma <+> ppName opts label - in text "phi" <+> ppr tp <+> hsep (punctuate comma $ map ppPreds preds) + in text "phi" <+> ppLlvmType tp <+> hsep (punctuate comma $ map ppPreds preds) +{-# SPECIALIZE ppPhi :: LlvmCgConfig -> LlvmType -> [(LlvmVar,LlvmVar)] -> SDoc #-} +{-# SPECIALIZE ppPhi :: LlvmCgConfig -> LlvmType -> [(LlvmVar,LlvmVar)] -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppSwitch :: LlvmCgConfig -> LlvmVar -> LlvmVar -> [(LlvmVar,LlvmVar)] -> SDoc +ppSwitch :: IsDoc doc => LlvmCgConfig -> LlvmVar -> LlvmVar -> [(LlvmVar,LlvmVar)] -> doc ppSwitch opts scrut dflt targets = - let ppTarget (val, lab) = ppVar opts val <> comma <+> ppVar opts lab - ppTargets xs = brackets $ vcat (map ppTarget xs) - in text "switch" <+> ppVar opts scrut <> comma <+> ppVar opts dflt - <+> ppTargets targets + let ppTarget (val, lab) = text " " <> ppVar opts val <> comma <+> ppVar opts lab + in lines_ $ concat + [ [text "switch" <+> ppVar opts scrut <> comma <+> ppVar opts dflt <+> char '['] + , map ppTarget targets + , [char ']'] + ] +{-# SPECIALIZE ppSwitch :: LlvmCgConfig -> LlvmVar -> LlvmVar -> [(LlvmVar,LlvmVar)] -> SDoc #-} +{-# SPECIALIZE ppSwitch :: LlvmCgConfig -> LlvmVar -> LlvmVar -> [(LlvmVar,LlvmVar)] -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppAsm :: LlvmCgConfig -> LMString -> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> SDoc +ppAsm :: IsLine doc => LlvmCgConfig -> LMString -> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> doc ppAsm opts asm constraints rty vars sideeffect alignstack = let asm' = doubleQuotes $ ftext asm cons = doubleQuotes $ ftext constraints - rty' = ppr rty - vars' = lparen <+> ppCommaJoin (map (ppVar opts) vars) <+> rparen + rty' = ppLlvmType rty + vars' = lparen <+> ppCommaJoin (ppVar opts) vars <+> rparen side = if sideeffect then text "sideeffect" else empty align = if alignstack then text "alignstack" else empty in text "call" <+> rty' <+> text "asm" <+> side <+> align <+> asm' <> comma <+> cons <> vars' +{-# SPECIALIZE ppAsm :: LlvmCgConfig -> LMString -> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> SDoc #-} +{-# SPECIALIZE ppAsm :: LlvmCgConfig -> LMString -> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppExtract :: LlvmCgConfig -> LlvmVar -> LlvmVar -> SDoc +ppExtract :: IsLine doc => LlvmCgConfig -> LlvmVar -> LlvmVar -> doc ppExtract opts vec idx = text "extractelement" - <+> ppr (getVarType vec) <+> ppName opts vec <> comma + <+> ppLlvmType (getVarType vec) <+> ppName opts vec <> comma <+> ppVar opts idx +{-# SPECIALIZE ppExtract :: LlvmCgConfig -> LlvmVar -> LlvmVar -> SDoc #-} +{-# SPECIALIZE ppExtract :: LlvmCgConfig -> LlvmVar -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppExtractV :: LlvmCgConfig -> LlvmVar -> Int -> SDoc +ppExtractV :: IsLine doc => LlvmCgConfig -> LlvmVar -> Int -> doc ppExtractV opts struct idx = text "extractvalue" - <+> ppr (getVarType struct) <+> ppName opts struct <> comma - <+> ppr idx + <+> ppLlvmType (getVarType struct) <+> ppName opts struct <> comma + <+> int idx +{-# SPECIALIZE ppExtractV :: LlvmCgConfig -> LlvmVar -> Int -> SDoc #-} +{-# SPECIALIZE ppExtractV :: LlvmCgConfig -> LlvmVar -> Int -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppInsert :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc +ppInsert :: IsLine doc => LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> doc ppInsert opts vec elt idx = text "insertelement" - <+> ppr (getVarType vec) <+> ppName opts vec <> comma - <+> ppr (getVarType elt) <+> ppName opts elt <> comma + <+> ppLlvmType (getVarType vec) <+> ppName opts vec <> comma + <+> ppLlvmType (getVarType elt) <+> ppName opts elt <> comma <+> ppVar opts idx +{-# SPECIALIZE ppInsert :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> SDoc #-} +{-# SPECIALIZE ppInsert :: LlvmCgConfig -> LlvmVar -> LlvmVar -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable - -ppMetaStatement :: LlvmCgConfig -> [MetaAnnot] -> LlvmStatement -> SDoc -ppMetaStatement opts meta stmt = - ppLlvmStatement opts stmt <> ppMetaAnnots opts meta - -ppMetaAnnotExpr :: LlvmCgConfig -> [MetaAnnot] -> LlvmExpression -> SDoc +ppMetaAnnotExpr :: IsLine doc => LlvmCgConfig -> [MetaAnnot] -> LlvmExpression -> doc ppMetaAnnotExpr opts meta expr = ppLlvmExpression opts expr <> ppMetaAnnots opts meta +{-# SPECIALIZE ppMetaAnnotExpr :: LlvmCgConfig -> [MetaAnnot] -> LlvmExpression -> SDoc #-} +{-# SPECIALIZE ppMetaAnnotExpr :: LlvmCgConfig -> [MetaAnnot] -> LlvmExpression -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppMetaAnnots :: LlvmCgConfig -> [MetaAnnot] -> SDoc +ppMetaAnnots :: IsLine doc => LlvmCgConfig -> [MetaAnnot] -> doc ppMetaAnnots opts meta = hcat $ map ppMeta meta where ppMeta (MetaAnnot name e) = comma <+> exclamation <> ftext name <+> case e of - MetaNode n -> ppr n - MetaStruct ms -> exclamation <> braces (ppCommaJoin (map (ppMetaExpr opts) ms)) + MetaNode n -> ppMetaId n + MetaStruct ms -> exclamation <> braces (ppCommaJoin (ppMetaExpr opts) ms) other -> exclamation <> braces (ppMetaExpr opts other) -- possible? +{-# SPECIALIZE ppMetaAnnots :: LlvmCgConfig -> [MetaAnnot] -> SDoc #-} +{-# SPECIALIZE ppMetaAnnots :: LlvmCgConfig -> [MetaAnnot] -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Return the variable name or value of the 'LlvmVar' -- in Llvm IR textual representation (e.g. @\@x@, @%y@ or @42@). -ppName :: LlvmCgConfig -> LlvmVar -> SDoc +ppName :: IsLine doc => LlvmCgConfig -> LlvmVar -> doc ppName opts v = case v of LMGlobalVar {} -> char '@' <> ppPlainName opts v LMLocalVar {} -> char '%' <> ppPlainName opts v LMNLocalVar {} -> char '%' <> ppPlainName opts v LMLitVar {} -> ppPlainName opts v +{-# SPECIALIZE ppName :: LlvmCgConfig -> LlvmVar -> SDoc #-} +{-# SPECIALIZE ppName :: LlvmCgConfig -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Return the variable name or value of the 'LlvmVar' -- in a plain textual representation (e.g. @x@, @y@ or @42@). -ppPlainName :: LlvmCgConfig -> LlvmVar -> SDoc +ppPlainName :: IsLine doc => LlvmCgConfig -> LlvmVar -> doc ppPlainName opts v = case v of (LMGlobalVar x _ _ _ _ _) -> ftext x (LMLocalVar x LMLabel ) -> pprUniqueAlways x (LMLocalVar x _ ) -> char 'l' <> pprUniqueAlways x (LMNLocalVar x _ ) -> ftext x (LMLitVar x ) -> ppLit opts x +{-# SPECIALIZE ppPlainName :: LlvmCgConfig -> LlvmVar -> SDoc #-} +{-# SPECIALIZE ppPlainName :: LlvmCgConfig -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Print a literal value. No type. -ppLit :: LlvmCgConfig -> LlvmLit -> SDoc +ppLit :: IsLine doc => LlvmCgConfig -> LlvmLit -> doc ppLit opts l = case l of - (LMIntLit i (LMInt 32)) -> ppr (fromInteger i :: Int32) - (LMIntLit i (LMInt 64)) -> ppr (fromInteger i :: Int64) - (LMIntLit i _ ) -> ppr ((fromInteger i)::Int) + (LMIntLit i _ ) -> integer i (LMFloatLit r LMFloat ) -> ppFloat (llvmCgPlatform opts) $ narrowFp r (LMFloatLit r LMDouble) -> ppDouble (llvmCgPlatform opts) r f@(LMFloatLit _ _) -> pprPanic "ppLit" (text "Can't print this float literal: " <> ppTypeLit opts f) - (LMVectorLit ls ) -> char '<' <+> ppCommaJoin (map (ppTypeLit opts) ls) <+> char '>' + (LMVectorLit ls ) -> char '<' <+> ppCommaJoin (ppTypeLit opts) ls <+> char '>' (LMNullLit _ ) -> text "null" -- #11487 was an issue where we passed undef for some arguments -- that were actually live. By chance the registers holding those @@ -544,61 +638,76 @@ ppLit opts l = case l of | llvmCgFillUndefWithGarbage opts , Just lit <- garbageLit t -> ppLit opts lit | otherwise -> text "undef" +{-# SPECIALIZE ppLit :: LlvmCgConfig -> LlvmLit -> SDoc #-} +{-# SPECIALIZE ppLit :: LlvmCgConfig -> LlvmLit -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppVar :: LlvmCgConfig -> LlvmVar -> SDoc +ppVar :: IsLine doc => LlvmCgConfig -> LlvmVar -> doc ppVar = ppVar' [] +{-# SPECIALIZE ppVar :: LlvmCgConfig -> LlvmVar -> SDoc #-} +{-# SPECIALIZE ppVar :: LlvmCgConfig -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppVar' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmVar -> SDoc +ppVar' :: IsLine doc => [LlvmParamAttr] -> LlvmCgConfig -> LlvmVar -> doc ppVar' attrs opts v = case v of LMLitVar x -> ppTypeLit' attrs opts x - x -> ppr (getVarType x) <+> ppSpaceJoin attrs <+> ppName opts x + x -> ppLlvmType (getVarType x) <+> ppSpaceJoin ppLlvmParamAttr attrs <+> ppName opts x +{-# SPECIALIZE ppVar' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmVar -> SDoc #-} +{-# SPECIALIZE ppVar' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppTypeLit :: LlvmCgConfig -> LlvmLit -> SDoc +ppTypeLit :: IsLine doc => LlvmCgConfig -> LlvmLit -> doc ppTypeLit = ppTypeLit' [] +{-# SPECIALIZE ppTypeLit :: LlvmCgConfig -> LlvmLit -> SDoc #-} +{-# SPECIALIZE ppTypeLit :: LlvmCgConfig -> LlvmLit -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppTypeLit' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> SDoc +ppTypeLit' :: IsLine doc => [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> doc ppTypeLit' attrs opts l = case l of LMVectorLit {} -> ppLit opts l - _ -> ppr (getLitType l) <+> ppSpaceJoin attrs <+> ppLit opts l + _ -> ppLlvmType (getLitType l) <+> ppSpaceJoin ppLlvmParamAttr attrs <+> ppLit opts l +{-# SPECIALIZE ppTypeLit' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> SDoc #-} +{-# SPECIALIZE ppTypeLit' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppStatic :: LlvmCgConfig -> LlvmStatic -> SDoc +ppStatic :: IsLine doc => LlvmCgConfig -> LlvmStatic -> doc ppStatic opts st = case st of LMComment s -> text "; " <> ftext s LMStaticLit l -> ppTypeLit opts l - LMUninitType t -> ppr t <> text " undef" - LMStaticStr s t -> ppr t <> text " c\"" <> ftext s <> text "\\00\"" - LMStaticArray d t -> ppr t <> text " [" <> ppCommaJoin (map (ppStatic opts) d) <> char ']' - LMStaticStruc d t -> ppr t <> text "<{" <> ppCommaJoin (map (ppStatic opts) d) <> text "}>" - LMStaticStrucU d t -> ppr t <> text "{" <> ppCommaJoin (map (ppStatic opts) d) <> text "}" + LMUninitType t -> ppLlvmType t <> text " undef" + LMStaticStr s t -> ppLlvmType t <> text " c\"" <> ftext s <> text "\\00\"" + LMStaticArray d t -> ppLlvmType t <> text " [" <> ppCommaJoin (ppStatic opts) d <> char ']' + LMStaticStruc d t -> ppLlvmType t <> text "<{" <> ppCommaJoin (ppStatic opts) d <> text "}>" + LMStaticStrucU d t -> ppLlvmType t <> text "{" <> ppCommaJoin (ppStatic opts) d <> text "}" LMStaticPointer v -> ppVar opts v - LMTrunc v t -> ppr t <> text " trunc (" <> ppStatic opts v <> text " to " <> ppr t <> char ')' - LMBitc v t -> ppr t <> text " bitcast (" <> ppStatic opts v <> text " to " <> ppr t <> char ')' - LMPtoI v t -> ppr t <> text " ptrtoint (" <> ppStatic opts v <> text " to " <> ppr t <> char ')' + LMTrunc v t -> ppLlvmType t <> text " trunc (" <> ppStatic opts v <> text " to " <> ppLlvmType t <> char ')' + LMBitc v t -> ppLlvmType t <> text " bitcast (" <> ppStatic opts v <> text " to " <> ppLlvmType t <> char ')' + LMPtoI v t -> ppLlvmType t <> text " ptrtoint (" <> ppStatic opts v <> text " to " <> ppLlvmType t <> char ')' LMAdd s1 s2 -> pprStaticArith opts s1 s2 (text "add") (text "fadd") (text "LMAdd") LMSub s1 s2 -> pprStaticArith opts s1 s2 (text "sub") (text "fsub") (text "LMSub") +{-# SPECIALIZE ppStatic :: LlvmCgConfig -> LlvmStatic -> SDoc #-} +{-# SPECIALIZE ppStatic :: LlvmCgConfig -> LlvmStatic -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -pprSpecialStatic :: LlvmCgConfig -> LlvmStatic -> SDoc +pprSpecialStatic :: IsLine doc => LlvmCgConfig -> LlvmStatic -> doc pprSpecialStatic opts stat = case stat of - LMBitc v t -> ppr (pLower t) + LMBitc v t -> ppLlvmType (pLower t) <> text ", bitcast (" - <> ppStatic opts v <> text " to " <> ppr t + <> ppStatic opts v <> text " to " <> ppLlvmType t <> char ')' - LMStaticPointer x -> ppr (pLower $ getVarType x) + LMStaticPointer x -> ppLlvmType (pLower $ getVarType x) <> comma <+> ppStatic opts stat _ -> ppStatic opts stat +{-# SPECIALIZE pprSpecialStatic :: LlvmCgConfig -> LlvmStatic -> SDoc #-} +{-# SPECIALIZE pprSpecialStatic :: LlvmCgConfig -> LlvmStatic -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -pprStaticArith :: LlvmCgConfig -> LlvmStatic -> LlvmStatic -> SDoc -> SDoc - -> SDoc -> SDoc +pprStaticArith :: IsLine doc => LlvmCgConfig -> LlvmStatic -> LlvmStatic -> doc -> doc -> SDoc -> doc pprStaticArith opts s1 s2 int_op float_op op_name = let ty1 = getStatType s1 op = if isFloat ty1 then float_op else int_op in if ty1 == getStatType s2 - then ppr ty1 <+> op <+> lparen <> ppStatic opts s1 <> comma <> ppStatic opts s2 <> rparen + then ppLlvmType ty1 <+> op <+> lparen <> ppStatic opts s1 <> comma <> ppStatic opts s2 <> rparen else pprPanic "pprStaticArith" $ op_name <> text " with different types! s1: " <> ppStatic opts s1 <> text", s2: " <> ppStatic opts s2 +{-# SPECIALIZE pprStaticArith :: LlvmCgConfig -> LlvmStatic -> LlvmStatic -> SDoc -> SDoc -> SDoc -> SDoc #-} +{-# SPECIALIZE pprStaticArith :: LlvmCgConfig -> LlvmStatic -> LlvmStatic -> HLine -> HLine -> SDoc -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -------------------------------------------------------------------------------- @@ -606,9 +715,13 @@ pprStaticArith opts s1 s2 int_op float_op op_name = -------------------------------------------------------------------------------- -- | Blank line. -newLine :: SDoc +newLine :: IsDoc doc => doc newLine = empty +{-# SPECIALIZE newLine :: SDoc #-} +{-# SPECIALIZE newLine :: HDoc #-} -- | Exclamation point. -exclamation :: SDoc +exclamation :: IsLine doc => doc exclamation = char '!' +{-# SPECIALIZE exclamation :: SDoc #-} +{-# SPECIALIZE exclamation :: HLine #-} ===================================== compiler/GHC/Llvm/Syntax.hs ===================================== @@ -150,7 +150,7 @@ data LlvmStatement * value: Variable/Constant to store. * ptr: Location to store the value in -} - | Store LlvmVar LlvmVar LMAlign + | Store LlvmVar LlvmVar LMAlign [MetaAnnot] {- | Multiway branch @@ -186,11 +186,6 @@ data LlvmStatement -} | Nop - {- | - A LLVM statement with metadata attached to it. - -} - | MetaStmt [MetaAnnot] LlvmStatement - deriving (Eq) ===================================== compiler/GHC/Llvm/Types.hs ===================================== @@ -1,6 +1,13 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} +-- Workaround for #21972. It can be removed once the minimal bootstrapping +-- compiler has a fix for this bug. +#if defined(darwin_HOST_OS) +{-# OPTIONS_GHC -fno-asm-shortcutting #-} +#endif + -------------------------------------------------------------------------------- -- | The LLVM Type System. -- @@ -61,28 +68,30 @@ data LlvmType deriving (Eq) instance Outputable LlvmType where - ppr = ppType + ppr = ppLlvmType -ppType :: LlvmType -> SDoc -ppType t = case t of - LMInt size -> char 'i' <> ppr size +ppLlvmType :: IsLine doc => LlvmType -> doc +ppLlvmType t = case t of + LMInt size -> char 'i' <> int size LMFloat -> text "float" LMDouble -> text "double" LMFloat80 -> text "x86_fp80" LMFloat128 -> text "fp128" - LMPointer x -> ppr x <> char '*' - LMArray nr tp -> char '[' <> ppr nr <> text " x " <> ppr tp <> char ']' - LMVector nr tp -> char '<' <> ppr nr <> text " x " <> ppr tp <> char '>' + LMPointer x -> ppLlvmType x <> char '*' + LMArray nr tp -> char '[' <> int nr <> text " x " <> ppLlvmType tp <> char ']' + LMVector nr tp -> char '<' <> int nr <> text " x " <> ppLlvmType tp <> char '>' LMLabel -> text "label" LMVoid -> text "void" - LMStruct tys -> text "<{" <> ppCommaJoin tys <> text "}>" - LMStructU tys -> text "{" <> ppCommaJoin tys <> text "}" + LMStruct tys -> text "<{" <> ppCommaJoin ppLlvmType tys <> text "}>" + LMStructU tys -> text "{" <> ppCommaJoin ppLlvmType tys <> text "}" LMMetadata -> text "metadata" LMAlias (s,_) -> char '%' <> ftext s LMFunction (LlvmFunctionDecl _ _ _ r varg p _) - -> ppr r <+> lparen <> ppParams varg p <> rparen + -> ppLlvmType r <+> lparen <> ppParams varg p <> rparen +{-# SPECIALIZE ppLlvmType :: LlvmType -> SDoc #-} +{-# SPECIALIZE ppLlvmType :: LlvmType -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc +ppParams :: IsLine doc => LlvmParameterListType -> [LlvmParameter] -> doc ppParams varg p = let varg' = case varg of VarArgs | null args -> text "..." @@ -90,7 +99,9 @@ ppParams varg p _otherwise -> text "" -- by default we don't print param attributes args = map fst p - in ppCommaJoin args <> varg' + in ppCommaJoin ppLlvmType args <> varg' +{-# SPECIALIZE ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc #-} +{-# SPECIALIZE ppParams :: LlvmParameterListType -> [LlvmParameter] -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | An LLVM section definition. If Nothing then let LLVM decide the section type LMSection = Maybe LMString @@ -337,14 +348,6 @@ data LlvmFunctionDecl = LlvmFunctionDecl { } deriving (Eq) -instance Outputable LlvmFunctionDecl where - ppr (LlvmFunctionDecl n l c r varg p a) - = let align = case a of - Just a' -> text " align " <> ppr a' - Nothing -> empty - in ppr l <+> ppr c <+> ppr r <+> char '@' <> ftext n <> - lparen <> ppParams varg p <> rparen <> align - type LlvmFunctionDecls = [LlvmFunctionDecl] type LlvmParameter = (LlvmType, [LlvmParamAttr]) @@ -385,14 +388,19 @@ data LlvmParamAttr deriving (Eq) instance Outputable LlvmParamAttr where - ppr ZeroExt = text "zeroext" - ppr SignExt = text "signext" - ppr InReg = text "inreg" - ppr ByVal = text "byval" - ppr SRet = text "sret" - ppr NoAlias = text "noalias" - ppr NoCapture = text "nocapture" - ppr Nest = text "nest" + ppr = ppLlvmParamAttr + +ppLlvmParamAttr :: IsLine doc => LlvmParamAttr -> doc +ppLlvmParamAttr ZeroExt = text "zeroext" +ppLlvmParamAttr SignExt = text "signext" +ppLlvmParamAttr InReg = text "inreg" +ppLlvmParamAttr ByVal = text "byval" +ppLlvmParamAttr SRet = text "sret" +ppLlvmParamAttr NoAlias = text "noalias" +ppLlvmParamAttr NoCapture = text "nocapture" +ppLlvmParamAttr Nest = text "nest" +{-# SPECIALIZE ppLlvmParamAttr :: LlvmParamAttr -> SDoc #-} +{-# SPECIALIZE ppLlvmParamAttr :: LlvmParamAttr -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Llvm Function Attributes. -- @@ -473,19 +481,24 @@ data LlvmFuncAttr deriving (Eq) instance Outputable LlvmFuncAttr where - ppr AlwaysInline = text "alwaysinline" - ppr InlineHint = text "inlinehint" - ppr NoInline = text "noinline" - ppr OptSize = text "optsize" - ppr NoReturn = text "noreturn" - ppr NoUnwind = text "nounwind" - ppr ReadNone = text "readnone" - ppr ReadOnly = text "readonly" - ppr Ssp = text "ssp" - ppr SspReq = text "ssqreq" - ppr NoRedZone = text "noredzone" - ppr NoImplicitFloat = text "noimplicitfloat" - ppr Naked = text "naked" + ppr = ppLlvmFuncAttr + +ppLlvmFuncAttr :: IsLine doc => LlvmFuncAttr -> doc +ppLlvmFuncAttr AlwaysInline = text "alwaysinline" +ppLlvmFuncAttr InlineHint = text "inlinehint" +ppLlvmFuncAttr NoInline = text "noinline" +ppLlvmFuncAttr OptSize = text "optsize" +ppLlvmFuncAttr NoReturn = text "noreturn" +ppLlvmFuncAttr NoUnwind = text "nounwind" +ppLlvmFuncAttr ReadNone = text "readnone" +ppLlvmFuncAttr ReadOnly = text "readonly" +ppLlvmFuncAttr Ssp = text "ssp" +ppLlvmFuncAttr SspReq = text "ssqreq" +ppLlvmFuncAttr NoRedZone = text "noredzone" +ppLlvmFuncAttr NoImplicitFloat = text "noimplicitfloat" +ppLlvmFuncAttr Naked = text "naked" +{-# SPECIALIZE ppLlvmFuncAttr :: LlvmFuncAttr -> SDoc #-} +{-# SPECIALIZE ppLlvmFuncAttr :: LlvmFuncAttr -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Different types to call a function. @@ -533,12 +546,17 @@ data LlvmCallConvention deriving (Eq) instance Outputable LlvmCallConvention where - ppr CC_Ccc = text "ccc" - ppr CC_Fastcc = text "fastcc" - ppr CC_Coldcc = text "coldcc" - ppr CC_Ghc = text "ghccc" - ppr (CC_Ncc i) = text "cc " <> ppr i - ppr CC_X86_Stdcc = text "x86_stdcallcc" + ppr = ppLlvmCallConvention + +ppLlvmCallConvention :: IsLine doc => LlvmCallConvention -> doc +ppLlvmCallConvention CC_Ccc = text "ccc" +ppLlvmCallConvention CC_Fastcc = text "fastcc" +ppLlvmCallConvention CC_Coldcc = text "coldcc" +ppLlvmCallConvention CC_Ghc = text "ghccc" +ppLlvmCallConvention (CC_Ncc i) = text "cc " <> int i +ppLlvmCallConvention CC_X86_Stdcc = text "x86_stdcallcc" +{-# SPECIALIZE ppLlvmCallConvention :: LlvmCallConvention -> SDoc #-} +{-# SPECIALIZE ppLlvmCallConvention :: LlvmCallConvention -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Functions can have a fixed amount of parameters, or a variable amount. @@ -597,17 +615,22 @@ data LlvmLinkageType deriving (Eq) instance Outputable LlvmLinkageType where - ppr Internal = text "internal" - ppr LinkOnce = text "linkonce" - ppr Weak = text "weak" - ppr Appending = text "appending" - ppr ExternWeak = text "extern_weak" - -- ExternallyVisible does not have a textual representation, it is - -- the linkage type a function resolves to if no other is specified - -- in Llvm. - ppr ExternallyVisible = empty - ppr External = text "external" - ppr Private = text "private" + ppr = ppLlvmLinkageType + +ppLlvmLinkageType :: IsLine doc => LlvmLinkageType -> doc +ppLlvmLinkageType Internal = text "internal" +ppLlvmLinkageType LinkOnce = text "linkonce" +ppLlvmLinkageType Weak = text "weak" +ppLlvmLinkageType Appending = text "appending" +ppLlvmLinkageType ExternWeak = text "extern_weak" +-- ExternallyVisible does not have a textual representation, it is +-- the linkage type a function resolves to if no other is specified +-- in Llvm. +ppLlvmLinkageType ExternallyVisible = empty +ppLlvmLinkageType External = text "external" +ppLlvmLinkageType Private = text "private" +{-# SPECIALIZE ppLlvmLinkageType :: LlvmLinkageType -> SDoc #-} +{-# SPECIALIZE ppLlvmLinkageType :: LlvmLinkageType -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- ----------------------------------------------------------------------------- -- * LLVM Operations @@ -645,24 +668,29 @@ data LlvmMachOp deriving (Eq) instance Outputable LlvmMachOp where - ppr LM_MO_Add = text "add" - ppr LM_MO_Sub = text "sub" - ppr LM_MO_Mul = text "mul" - ppr LM_MO_UDiv = text "udiv" - ppr LM_MO_SDiv = text "sdiv" - ppr LM_MO_URem = text "urem" - ppr LM_MO_SRem = text "srem" - ppr LM_MO_FAdd = text "fadd" - ppr LM_MO_FSub = text "fsub" - ppr LM_MO_FMul = text "fmul" - ppr LM_MO_FDiv = text "fdiv" - ppr LM_MO_FRem = text "frem" - ppr LM_MO_Shl = text "shl" - ppr LM_MO_LShr = text "lshr" - ppr LM_MO_AShr = text "ashr" - ppr LM_MO_And = text "and" - ppr LM_MO_Or = text "or" - ppr LM_MO_Xor = text "xor" + ppr = ppLlvmMachOp + +ppLlvmMachOp :: IsLine doc => LlvmMachOp -> doc +ppLlvmMachOp LM_MO_Add = text "add" +ppLlvmMachOp LM_MO_Sub = text "sub" +ppLlvmMachOp LM_MO_Mul = text "mul" +ppLlvmMachOp LM_MO_UDiv = text "udiv" +ppLlvmMachOp LM_MO_SDiv = text "sdiv" +ppLlvmMachOp LM_MO_URem = text "urem" +ppLlvmMachOp LM_MO_SRem = text "srem" +ppLlvmMachOp LM_MO_FAdd = text "fadd" +ppLlvmMachOp LM_MO_FSub = text "fsub" +ppLlvmMachOp LM_MO_FMul = text "fmul" +ppLlvmMachOp LM_MO_FDiv = text "fdiv" +ppLlvmMachOp LM_MO_FRem = text "frem" +ppLlvmMachOp LM_MO_Shl = text "shl" +ppLlvmMachOp LM_MO_LShr = text "lshr" +ppLlvmMachOp LM_MO_AShr = text "ashr" +ppLlvmMachOp LM_MO_And = text "and" +ppLlvmMachOp LM_MO_Or = text "or" +ppLlvmMachOp LM_MO_Xor = text "xor" +{-# SPECIALIZE ppLlvmMachOp :: LlvmMachOp -> SDoc #-} +{-# SPECIALIZE ppLlvmMachOp :: LlvmMachOp -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Llvm compare operations. @@ -689,22 +717,27 @@ data LlvmCmpOp deriving (Eq) instance Outputable LlvmCmpOp where - ppr LM_CMP_Eq = text "eq" - ppr LM_CMP_Ne = text "ne" - ppr LM_CMP_Ugt = text "ugt" - ppr LM_CMP_Uge = text "uge" - ppr LM_CMP_Ult = text "ult" - ppr LM_CMP_Ule = text "ule" - ppr LM_CMP_Sgt = text "sgt" - ppr LM_CMP_Sge = text "sge" - ppr LM_CMP_Slt = text "slt" - ppr LM_CMP_Sle = text "sle" - ppr LM_CMP_Feq = text "oeq" - ppr LM_CMP_Fne = text "une" - ppr LM_CMP_Fgt = text "ogt" - ppr LM_CMP_Fge = text "oge" - ppr LM_CMP_Flt = text "olt" - ppr LM_CMP_Fle = text "ole" + ppr = ppLlvmCmpOp + +ppLlvmCmpOp :: IsLine doc => LlvmCmpOp -> doc +ppLlvmCmpOp LM_CMP_Eq = text "eq" +ppLlvmCmpOp LM_CMP_Ne = text "ne" +ppLlvmCmpOp LM_CMP_Ugt = text "ugt" +ppLlvmCmpOp LM_CMP_Uge = text "uge" +ppLlvmCmpOp LM_CMP_Ult = text "ult" +ppLlvmCmpOp LM_CMP_Ule = text "ule" +ppLlvmCmpOp LM_CMP_Sgt = text "sgt" +ppLlvmCmpOp LM_CMP_Sge = text "sge" +ppLlvmCmpOp LM_CMP_Slt = text "slt" +ppLlvmCmpOp LM_CMP_Sle = text "sle" +ppLlvmCmpOp LM_CMP_Feq = text "oeq" +ppLlvmCmpOp LM_CMP_Fne = text "une" +ppLlvmCmpOp LM_CMP_Fgt = text "ogt" +ppLlvmCmpOp LM_CMP_Fge = text "oge" +ppLlvmCmpOp LM_CMP_Flt = text "olt" +ppLlvmCmpOp LM_CMP_Fle = text "ole" +{-# SPECIALIZE ppLlvmCmpOp :: LlvmCmpOp -> SDoc #-} +{-# SPECIALIZE ppLlvmCmpOp :: LlvmCmpOp -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- | Llvm cast operations. @@ -724,18 +757,23 @@ data LlvmCastOp deriving (Eq) instance Outputable LlvmCastOp where - ppr LM_Trunc = text "trunc" - ppr LM_Zext = text "zext" - ppr LM_Sext = text "sext" - ppr LM_Fptrunc = text "fptrunc" - ppr LM_Fpext = text "fpext" - ppr LM_Fptoui = text "fptoui" - ppr LM_Fptosi = text "fptosi" - ppr LM_Uitofp = text "uitofp" - ppr LM_Sitofp = text "sitofp" - ppr LM_Ptrtoint = text "ptrtoint" - ppr LM_Inttoptr = text "inttoptr" - ppr LM_Bitcast = text "bitcast" + ppr = ppLlvmCastOp + +ppLlvmCastOp :: IsLine doc => LlvmCastOp -> doc +ppLlvmCastOp LM_Trunc = text "trunc" +ppLlvmCastOp LM_Zext = text "zext" +ppLlvmCastOp LM_Sext = text "sext" +ppLlvmCastOp LM_Fptrunc = text "fptrunc" +ppLlvmCastOp LM_Fpext = text "fpext" +ppLlvmCastOp LM_Fptoui = text "fptoui" +ppLlvmCastOp LM_Fptosi = text "fptosi" +ppLlvmCastOp LM_Uitofp = text "uitofp" +ppLlvmCastOp LM_Sitofp = text "sitofp" +ppLlvmCastOp LM_Ptrtoint = text "ptrtoint" +ppLlvmCastOp LM_Inttoptr = text "inttoptr" +ppLlvmCastOp LM_Bitcast = text "bitcast" +{-# SPECIALIZE ppLlvmCastOp :: LlvmCastOp -> SDoc #-} +{-# SPECIALIZE ppLlvmCastOp :: LlvmCastOp -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- ----------------------------------------------------------------------------- @@ -747,7 +785,7 @@ instance Outputable LlvmCastOp where -- regardless of underlying architecture. -- -- See Note [LLVM Float Types]. -ppDouble :: Platform -> Double -> SDoc +ppDouble :: IsLine doc => Platform -> Double -> doc ppDouble platform d = let bs = doubleToBytes d hex d' = case showHex d' "" of @@ -761,6 +799,8 @@ ppDouble platform d LittleEndian -> reverse str = map toUpper $ concat $ fixEndian $ map hex bs in text "0x" <> text str +{-# SPECIALIZE ppDouble :: Platform -> Double -> SDoc #-} +{-# SPECIALIZE ppDouble :: Platform -> Double -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- Note [LLVM Float Types] -- ~~~~~~~~~~~~~~~~~~~~~~~ @@ -787,16 +827,22 @@ widenFp :: Float -> Double {-# NOINLINE widenFp #-} widenFp = float2Double -ppFloat :: Platform -> Float -> SDoc +ppFloat :: IsLine doc => Platform -> Float -> doc ppFloat platform = ppDouble platform . widenFp +{-# SPECIALIZE ppFloat :: Platform -> Float -> SDoc #-} +{-# SPECIALIZE ppFloat :: Platform -> Float -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -------------------------------------------------------------------------------- -- * Misc functions -------------------------------------------------------------------------------- -ppCommaJoin :: (Outputable a) => [a] -> SDoc -ppCommaJoin strs = hsep $ punctuate comma (map ppr strs) +ppCommaJoin :: IsLine doc => (a -> doc) -> [a] -> doc +ppCommaJoin ppr strs = hsep $ punctuate comma (map ppr strs) +{-# SPECIALIZE ppCommaJoin :: (a -> SDoc) -> [a] -> SDoc #-} +{-# SPECIALIZE ppCommaJoin :: (a -> HLine) -> [a] -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -ppSpaceJoin :: (Outputable a) => [a] -> SDoc -ppSpaceJoin strs = hsep (map ppr strs) +ppSpaceJoin :: IsLine doc => (a -> doc) -> [a] -> doc +ppSpaceJoin ppr strs = hsep (map ppr strs) +{-# SPECIALIZE ppSpaceJoin :: (a -> SDoc) -> [a] -> SDoc #-} +{-# SPECIALIZE ppSpaceJoin :: (a -> HLine) -> [a] -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8b4aac437b2620d93546a57eb5818f317a4549e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8b4aac437b2620d93546a57eb5818f317a4549e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 22:12:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 21 Mar 2023 18:12:31 -0400 Subject: [Git][ghc/ghc][master] Compute LambdaFormInfo when using JavaScript backend. Message-ID: <641a2bcff254d_90da2331b5b44390c3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 5 changed files: - compiler/GHC/Driver/Main.hs - testsuite/tests/driver/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/stranal/should_run/all.T Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -204,7 +204,7 @@ import GHC.Builtin.Names import GHC.Builtin.Uniques ( mkPseudoUniqueE ) import qualified GHC.StgToCmm as StgToCmm ( codeGen ) -import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) +import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos, LambdaFormInfo(..)) import GHC.Cmm import GHC.Cmm.Info.Build @@ -230,6 +230,7 @@ import GHC.Types.Id import GHC.Types.SourceError import GHC.Types.SafeHaskell import GHC.Types.ForeignStubs +import GHC.Types.Name.Env ( mkNameEnv ) import GHC.Types.Var.Env ( emptyTidyEnv ) import GHC.Types.Error import GHC.Types.Fixity.Env @@ -1872,7 +1873,19 @@ hscGenHardCode hsc_env cgguts location output_filename = do JSCodeOutput -> do let js_config = initStgToJSConfig dflags - cmm_cg_infos = Nothing + + -- The JavaScript backend does not create CmmCgInfos like the Cmm backend, + -- but it is needed for writing the interface file. Here we compute a very + -- conservative but correct value. + lf_infos (StgTopLifted (StgNonRec b _)) = [(idName b, LFUnknown True)] + lf_infos (StgTopLifted (StgRec bs)) = map (\(b,_) -> (idName b, LFUnknown True)) bs + lf_infos (StgTopStringLit b _) = [(idName b, LFUnlifted)] + + cmm_cg_infos = CmmCgInfos + { cgNonCafs = mempty + , cgLFInfos = mkNameEnv (concatMap lf_infos stg_binds) + , cgIPEStub = mempty + } stub_c_exists = Nothing foreign_fps = [] @@ -1881,7 +1894,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do -- do the unfortunately effectual business stgToJS logger js_config stg_binds this_mod spt_entries foreign_stubs0 cost_centre_info output_filename - return (output_filename, stub_c_exists, foreign_fps, Just stg_cg_infos, cmm_cg_infos) + return (output_filename, stub_c_exists, foreign_fps, Just stg_cg_infos, Just cmm_cg_infos) _ -> do ===================================== testsuite/tests/driver/all.T ===================================== @@ -278,7 +278,7 @@ test('T13604a', ], makefile_test, []) # omitting hpc and profasm because they affect the # inlining and unfoldings -test('inline-check', [omit_ways(['hpc', 'profasm']), js_broken(22576)] +test('inline-check', [omit_ways(['hpc', 'profasm'])] , compile , ['-dinline-check foo -O -ddebug-output']) ===================================== testsuite/tests/lib/integer/all.T ===================================== @@ -5,9 +5,9 @@ test('plusMinusInteger', [omit_ways(['ghci'])], compile_and_run, ['']) test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding']) test('naturalConstantFolding', normal, makefile_test, ['naturalConstantFolding']) -test('fromToInteger', js_broken(22576), makefile_test, ['fromToInteger']) +test('fromToInteger', normal, makefile_test, ['fromToInteger']) -test('IntegerConversionRules', [js_broken(22576)], makefile_test, ['IntegerConversionRules']) +test('IntegerConversionRules', normal, makefile_test, ['IntegerConversionRules']) test('gcdInteger', normal, compile_and_run, ['']) test('gcdeInteger', normal, compile_and_run, ['']) test('integerPowMod', [], compile_and_run, ['']) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -378,7 +378,7 @@ test('T20200a', normal, compile, ['-O2']) test('T20200b', normal, compile, ['-O2']) test('T20200KG', [extra_files(['T20200KGa.hs', 'T20200KG.hs-boot'])], multimod_compile, ['T20200KG', '-v0 -O2 -fspecialise-aggressively']) test('T20639', normal, compile, ['-O2']) -test('T20894', js_broken(22576), compile, ['-dcore-lint -O1 -ddebug-output']) +test('T20894', normal, compile, ['-dcore-lint -O1 -ddebug-output']) test('T19790', normal, compile, ['-O -ddump-rule-firings']) # This one had a Lint failure due to an occurrence analysis bug ===================================== testsuite/tests/stranal/should_run/all.T ===================================== @@ -1,6 +1,6 @@ # Run this always as we compile the test with -O0 and -O1 and check that the # output is correct and the same in both cases. -test('T16197', js_broken(22576), makefile_test, []) +test('T16197', normal, makefile_test, []) # Run the rest only in optasm way (which implies -O), we're testing the # strictness analyser here View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea24360d0548c905b6b2427b5cdcb82d3cd296ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea24360d0548c905b6b2427b5cdcb82d3cd296ae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 22:15:40 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 21 Mar 2023 18:15:40 -0400 Subject: [Git][ghc/ghc][wip/T23070] 11 commits: Rename () into Unit, (, , ..., , ) into Tuple (#21294) Message-ID: <641a2c8c37d9_90da23614a18439652@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070 at Glasgow Haskell Compiler / GHC Commits: a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 37faaad4 by Simon Peyton Jones at 2023-03-21T22:17:11+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - 20 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Instance/Class.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f83ff87f5b64003518d194219257267f8b177c9b...37faaad4c63183866dd6ef6ba0dc5e8b37d19bed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f83ff87f5b64003518d194219257267f8b177c9b...37faaad4c63183866dd6ef6ba0dc5e8b37d19bed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 22:43:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 21 Mar 2023 18:43:04 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Allow LLVM backend to use HDoc for faster file generation. Message-ID: <641a32f882d3f_90da23b0a6d04485e9@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - b229d131 by Simon Peyton Jones at 2023-03-21T18:42:45-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 9004f99d by Sylvain Henry at 2023-03-21T18:42:55-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - c3c95364 by romes at 2023-03-21T18:42:56-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - b03f0c28 by Sylvain Henry at 2023-03-21T18:42:58-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - b9c7550f by Sylvain Henry at 2023-03-21T18:42:58-04:00 Testsuite: use req_interp predicate for T20214 - - - - - 30 changed files: - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Validity.hs - libraries/base/GHC/TypeError.hs - libraries/base/changelog.md - testsuite/tests/driver/T16318/all.T - testsuite/tests/driver/all.T - testsuite/tests/ghci/should_fail/all.T - testsuite/tests/lib/integer/all.T - testsuite/tests/rep-poly/RepPolyArgument.stderr - testsuite/tests/rep-poly/RepPolyDoBind.stderr - testsuite/tests/rep-poly/RepPolyDoBody1.stderr - testsuite/tests/rep-poly/RepPolyDoBody2.stderr - testsuite/tests/rep-poly/RepPolyLeftSection2.stderr - testsuite/tests/rep-poly/RepPolyMcBind.stderr - testsuite/tests/rep-poly/RepPolyMcBody.stderr - testsuite/tests/rep-poly/RepPolyMcGuard.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c111986a286e9139038779e02abdfe23c1b170fc...b9c7550f7b786de1b9f9dc0281d7d4733ece5f0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c111986a286e9139038779e02abdfe23c1b170fc...b9c7550f7b786de1b9f9dc0281d7d4733ece5f0e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 23:06:45 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 21 Mar 2023 19:06:45 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] 35 commits: Fix BCO creation setting caps when -j > -N Message-ID: <641a3885565a0_90da2413aa8c457245@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 37faaad4 by Simon Peyton Jones at 2023-03-21T22:17:11+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - 0c34787b by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 DRAFT: Refactor the way we establish a canonical constraint Relevant to #22194 Incomplete; but I'd like to see the CI results - - - - - 5156c482 by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Wibbles - - - - - 7f3dd89e by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Wibbles - - - - - 2583cff1 by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Wibbles - - - - - 9cebb48a by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Use a flag-based approach for checkTyEqRhs ...looks much nicer - - - - - e3bcdc3f by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Wibble - - - - - 90f4e1be by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Bug fixes - - - - - 42b57ab8 by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 More bug fixes - - - - - bcaf3287 by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Minor fixes - - - - - bc271f1e by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Fix isConcreteTyCon Adds a synIsConcrete to SynonymTyCon - - - - - 869fe1dd by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 More wibbles - - - - - c9e32090 by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Add a fast path simpleUnifyCheck - - - - - 109a2115 by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Wibble - - - - - a4160388 by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Respond to Richard's review - - - - - 28b6a57d by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 More wibbles, prompted by talking with Richard - - - - - d47b0f8b by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 More wibbles - - - - - 1568b9ed by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Wibbles - - - - - 96ecd73a by Simon Peyton Jones at 2023-03-21T22:20:44+00:00 Wibble - - - - - bd132a9b by Simon Peyton Jones at 2023-03-21T23:08:11+00:00 Wibbles - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bbba89ea59ce41364b4b3a4fba7969ca2c711d28...bd132a9b37ce1b7c35bffe7a161415db3cde4ccb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bbba89ea59ce41364b4b3a4fba7969ca2c711d28...bd132a9b37ce1b7c35bffe7a161415db3cde4ccb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 21 23:50:59 2023 From: gitlab at gitlab.haskell.org (ase (@adamse)) Date: Tue, 21 Mar 2023 19:50:59 -0400 Subject: [Git][ghc/ghc][wip/adamse/stableptr-clarifications] rts: improve StablePtr.c Message-ID: <641a42e39721_90da24f6aae4472379@gitlab.mail> ase pushed to branch wip/adamse/stableptr-clarifications at Glasgow Haskell Compiler / GHC Commits: a17224fb by Adam Sandberg Ericsson at 2023-03-21T23:50:47+00:00 rts: improve StablePtr.c - - - - - 1 changed file: - rts/StablePtr.c Changes: ===================================== rts/StablePtr.c ===================================== @@ -98,8 +98,13 @@ */ +// the global stable pointer entry table spEntry *stable_ptr_table = NULL; + +// the next free stable ptr, the free entries form a linked list where spEntry.addr points to the next after static spEntry *stable_ptr_free = NULL; + +// current stable pointer table size static unsigned int SPT_size = 0; #define INIT_SPT_SIZE 64 @@ -117,6 +122,7 @@ static unsigned int SPT_size = 0; #error unknown SIZEOF_VOID_P #endif +// old stable pointer tables static spEntry *old_SPTs[MAX_N_OLD_SPTS]; static uint32_t n_old_SPTs = 0; @@ -149,8 +155,9 @@ stablePtrUnlock(void) * -------------------------------------------------------------------------- */ STATIC_INLINE void -initSpEntryFreeList(spEntry *table, uint32_t n, spEntry *free) +initSpEntryFreeList(spEntry *table, uint32_t n) { + spEntry* free = NULL; spEntry *p; for (p = table + n - 1; p >= table; p--) { p->addr = (P_)free; @@ -166,7 +173,7 @@ initStablePtrTable(void) SPT_size = INIT_SPT_SIZE; stable_ptr_table = stgMallocBytes(SPT_size * sizeof(spEntry), "initStablePtrTable"); - initSpEntryFreeList(stable_ptr_table,INIT_SPT_SIZE,NULL); + initSpEntryFreeList(stable_ptr_table,INIT_SPT_SIZE); #if defined(THREADED_RTS) initMutex(&stable_ptr_mutex); @@ -181,6 +188,8 @@ initStablePtrTable(void) static void enlargeStablePtrTable(void) { + ASSERT_LOCK_HELD(&stable_ptr_mutex); + uint32_t old_SPT_size = SPT_size; spEntry *new_stable_ptr_table; @@ -206,7 +215,8 @@ enlargeStablePtrTable(void) */ RELEASE_STORE(&stable_ptr_table, new_stable_ptr_table); - initSpEntryFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL); + // add the new entries to the free list + initSpEntryFreeList(stable_ptr_table + old_SPT_size, old_SPT_size); } /* Note [Enlarging the stable pointer table] @@ -245,6 +255,7 @@ exitStablePtrTable(void) { if (stable_ptr_table) stgFree(stable_ptr_table); + stable_ptr_table = NULL; SPT_size = 0; @@ -265,12 +276,17 @@ freeSpEntry(spEntry *sp) void freeStablePtrUnsafe(StgStablePtr sp) { + ASSERT_LOCK_HELD(&stable_ptr_mutex); + // see Note [NULL StgStablePtr] if (sp == NULL) { return; } + StgWord spw = (StgWord)sp - 1; + ASSERT(spw < SPT_size); + freeSpEntry(&stable_ptr_table[spw]); } @@ -278,25 +294,35 @@ void freeStablePtr(StgStablePtr sp) { stablePtrLock(); + freeStablePtrUnsafe(sp); + stablePtrUnlock(); } /* ----------------------------------------------------------------------------- - * Looking up + * Allocating stable pointers * -------------------------------------------------------------------------- */ StgStablePtr getStablePtr(StgPtr p) { - StgWord sp; - stablePtrLock(); - if (!stable_ptr_free) enlargeStablePtrTable(); - sp = stable_ptr_free - stable_ptr_table; - stable_ptr_free = (spEntry*)(stable_ptr_free->addr); - RELAXED_STORE(&stable_ptr_table[sp].addr, p); + + if (!stable_ptr_free) + enlargeStablePtrTable(); + + // find the index of free stable ptr + StgWord sp = stable_ptr_free - stable_ptr_table; + + // unlink the table entry we grabbed from the free list + stable_ptr_free = (spEntry*)(stable_ptr_free->addr); + + // release store to pair with acquire load in deRefStablePtr + RELEASE_STORE(&stable_ptr_table[sp].addr, p); + stablePtrUnlock(); + // see Note [NULL StgStablePtr] sp = sp + 1; return (StgStablePtr)(sp); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a17224fbe4f1f8cdc06b3fafb8609ef4ac20f6f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a17224fbe4f1f8cdc06b3fafb8609ef4ac20f6f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 05:03:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 22 Mar 2023 01:03:30 -0400 Subject: [Git][ghc/ghc][master] Be more careful about quantification Message-ID: <641a8c224724e_90da29ccda984965a6@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 27 changed files: - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Validity.hs - testsuite/tests/rep-poly/RepPolyArgument.stderr - testsuite/tests/rep-poly/RepPolyDoBind.stderr - testsuite/tests/rep-poly/RepPolyDoBody1.stderr - testsuite/tests/rep-poly/RepPolyDoBody2.stderr - testsuite/tests/rep-poly/RepPolyLeftSection2.stderr - testsuite/tests/rep-poly/RepPolyMcBind.stderr - testsuite/tests/rep-poly/RepPolyMcBody.stderr - testsuite/tests/rep-poly/RepPolyMcGuard.stderr - testsuite/tests/rep-poly/RepPolyNPlusK.stderr - testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr - testsuite/tests/rep-poly/RepPolyRule1.stderr - testsuite/tests/rep-poly/RepPolyTupleSection.stderr - testsuite/tests/rep-poly/T12709.stderr - testsuite/tests/rep-poly/T12973.stderr - testsuite/tests/rep-poly/T13929.stderr - testsuite/tests/rep-poly/T19615.stderr - testsuite/tests/rep-poly/T19709b.stderr - + testsuite/tests/rep-poly/T23051.hs - + testsuite/tests/rep-poly/T23051.stderr - testsuite/tests/rep-poly/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -903,15 +903,19 @@ mkInferredPolyId residual insoluble qtvs inferred_theta poly_name mb_sig_inst mo ; let inferred_poly_ty = mkInvisForAllTys binders (mkPhiTy theta' mono_ty') ; traceTc "mkInferredPolyId" (vcat [ppr poly_name, ppr qtvs, ppr theta' - , ppr inferred_poly_ty]) + , ppr inferred_poly_ty + , text "insoluble" <+> ppr insoluble ]) + ; unless insoluble $ addErrCtxtM (mk_inf_msg poly_name inferred_poly_ty) $ do { checkEscapingKind inferred_poly_ty + -- See Note [Inferred type with escaping kind] ; checkValidType (InfSigCtxt poly_name) inferred_poly_ty } - -- See Note [Validity of inferred types] - -- If we found an insoluble error in the function definition, don't - -- do this check; otherwise (#14000) we may report an ambiguity - -- error for a rather bogus type. + -- See Note [Validity of inferred types] + -- unless insoluble: if we found an insoluble error in the + -- function definition, don't do this check; otherwise + -- (#14000) we may report an ambiguity error for a rather + -- bogus type. ; return (mkLocalId poly_name ManyTy inferred_poly_ty) } @@ -1176,6 +1180,33 @@ Examples that might fail: or multi-parameter type classes - an inferred type that includes unboxed tuples +Note [Inferred type with escaping kind] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Check for an inferred type with an escaping kind; e.g. #23051 + forall {k} {f :: k -> RuntimeRep} {g :: k} {a :: TYPE (f g)}. a +where the kind of the body of the forall mentions `f` and `g` which +are bound by the forall. No no no. + +This check, mkInferredPolyId, is really in the wrong place: +`inferred_poly_ty` doesn't obey the PKTI and it would be better not to +generalise it in the first place; see #20686. But for now it works. + +How else could we avoid generalising over escaping type variables? I +considered: + +* Adjust the generalisation in GHC.Tc.Solver to directly check for + escaping kind variables; instead, promote or default them. But that + gets into the defaulting swamp and is a non-trivial and unforced + change, so I have left it alone for now. + +* When inferring the type of a binding, in `tcMonoBinds`, we create + an ExpSigmaType with `tcInfer`. If we simply gave it an ir_frr field + that said "must have fixed runtime rep", then the kind would be made + Concrete; and we never generalise over Concrete variables. A bit + more indirect, but we need the "don't generalise over Concrete variables" + stuff anyway. + + Note [Impedance matching] ~~~~~~~~~~~~~~~~~~~~~~~~~ Consider ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2037,7 +2037,7 @@ typecheck/should_compile/tc170). Moreover in instance heads we get forall-types with kind Constraint. -It's tempting to check that the body kind is either * or #. But this is +It's tempting to check that the body kind is (TYPE _). But this is wrong. For example: class C a b @@ -2046,7 +2046,7 @@ wrong. For example: We're doing newtype-deriving for C. But notice how `a` isn't in scope in the predicate `C a`. So we quantify, yielding `forall a. C a` even though `C a` has kind `* -> Constraint`. The `forall a. C a` is a bit cheeky, but -convenient. Bottom line: don't check for * or # here. +convenient. Bottom line: don't check for (TYPE _) here. Note [Body kind of a HsQualTy] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -3547,8 +3547,12 @@ kindGeneralizeSome skol_info wanted kind_or_type -- here will already have all type variables quantified; -- thus, every free variable is really a kv, never a tv. ; dvs <- candidateQTyVarsOfKind kind_or_type - ; dvs <- filterConstrainedCandidates wanted dvs - ; quantifyTyVars skol_info DefaultNonStandardTyVars dvs } + ; filtered_dvs <- filterConstrainedCandidates wanted dvs + ; traceTc "kindGeneralizeSome" $ + vcat [ text "type:" <+> ppr kind_or_type + , text "dvs:" <+> ppr dvs + , text "filtered_dvs:" <+> ppr filtered_dvs ] + ; quantifyTyVars skol_info DefaultNonStandardTyVars filtered_dvs } filterConstrainedCandidates :: WantedConstraints -- Don't quantify over variables free in these ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1279,10 +1279,6 @@ emitResidualConstraints rhs_tclvl ev_binds_var -- uniformly. -------------------- -ctsPreds :: Cts -> [PredType] -ctsPreds cts = [ ctEvPred ev | ct <- bagToList cts - , let ev = ctEvidence ct ] - findInferredDiff :: TcThetaType -> TcThetaType -> TcM TcThetaType -- Given a partial type signature f :: (C a, D a, _) => blah -- and the inferred constraints (X a, D a, Y a, C a) @@ -1397,7 +1393,7 @@ Note [Deciding quantification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If the monomorphism restriction does not apply, then we quantify as follows: -* Step 1: decideMonoTyVars. +* Step 1: decidePromotedTyVars. Take the global tyvars, and "grow" them using functional dependencies E.g. if x:alpha is in the environment, and alpha ~ [beta] (which can happen because alpha is untouchable here) then do not quantify over @@ -1408,10 +1404,11 @@ If the monomorphism restriction does not apply, then we quantify as follows: We also account for the monomorphism restriction; if it applies, add the free vars of all the constraints. - Result is mono_tvs; we will not quantify over these. + Result is mono_tvs; we will promote all of these to the outer levek, + and certainly not quantify over them. * Step 2: defaultTyVarsAndSimplify. - Default any non-mono tyvars (i.e ones that are definitely + Default any non-promoted tyvars (i.e ones that are definitely not going to become further constrained), and re-simplify the candidate constraints. @@ -1431,7 +1428,7 @@ If the monomorphism restriction does not apply, then we quantify as follows: over are determined in Step 3 (not in Step 1), it is OK for the mono_tvs to be missing some variables free in the environment. This is why removing the psig_qtvs is OK in - decideMonoTyVars. Test case for this scenario: T14479. + decidePromotedTyVars. Test case for this scenario: T14479. * Step 3: decideQuantifiedTyVars. Decide which variables to quantify over, as follows: @@ -1559,7 +1556,7 @@ and we are running simplifyInfer over These are two implication constraints, both of which contain a wanted for the class C. Neither constraint mentions the bound -skolem. We might imagine that these constraint could thus float +skolem. We might imagine that these constraints could thus float out of their implications and then interact, causing beta1 to unify with beta2, but constraints do not currently float out of implications. @@ -1609,12 +1606,12 @@ decideQuantification -- See Note [Deciding quantification] decideQuantification skol_info infer_mode rhs_tclvl name_taus psigs candidates = do { -- Step 1: find the mono_tvs - ; (mono_tvs, candidates, co_vars) <- decideMonoTyVars infer_mode - name_taus psigs candidates + ; (candidates, co_vars) <- decidePromotedTyVars infer_mode + name_taus psigs candidates -- Step 2: default any non-mono tyvars, and re-simplify -- This step may do some unification, but result candidates is zonked - ; candidates <- defaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates + ; candidates <- defaultTyVarsAndSimplify rhs_tclvl candidates -- Step 3: decide which kind/type variables to quantify over ; qtvs <- decideQuantifiedTyVars skol_info name_taus psigs candidates @@ -1647,7 +1644,6 @@ decideQuantification skol_info infer_mode rhs_tclvl name_taus psigs candidates (vcat [ text "infer_mode:" <+> ppr infer_mode , text "candidates:" <+> ppr candidates , text "psig_theta:" <+> ppr psig_theta - , text "mono_tvs:" <+> ppr mono_tvs , text "co_vars:" <+> ppr co_vars , text "qtvs:" <+> ppr qtvs , text "theta:" <+> ppr theta ]) @@ -1686,23 +1682,34 @@ ambiguous types. Something like But that's a battle for another day. -} -decideMonoTyVars :: InferMode - -> [(Name,TcType)] - -> [TcIdSigInst] - -> [PredType] - -> TcM (TcTyCoVarSet, [PredType], CoVarSet) --- Decide which tyvars and covars cannot be generalised: --- (a) Free in the environment --- (b) Mentioned in a constraint we can't generalise --- (c) Connected by an equality or fundep to (a) or (b) +decidePromotedTyVars :: InferMode + -> [(Name,TcType)] + -> [TcIdSigInst] + -> [PredType] + -> TcM ([PredType], CoVarSet) +-- We are about to generalise over type variables at level N +-- Each must be either +-- (P) promoted +-- (D) defaulted +-- (Q) quantified +-- This function finds (P), the type variables that we are going to promote: +-- (a) Mentioned in a constraint we can't generalise (the MR) +-- (b) Mentioned in the kind of a CoVar; we can't quantify over a CoVar, +-- so we must not quantify over a type variable free in its kind +-- (c) Connected by an equality or fundep to +-- * a type variable at level < N, or +-- * A tyvar subject to (a), (b) or (c) +-- Having found all such level-N tyvars that we can't generalise, +-- promote them, to eliminate them from further consideration. +-- -- Also return CoVars that appear free in the final quantified types -- we can't quantify over these, and we must make sure they are in scope -decideMonoTyVars infer_mode name_taus psigs candidates +decidePromotedTyVars infer_mode name_taus psigs candidates = do { (no_quant, maybe_quant) <- pick infer_mode candidates -- If possible, we quantify over partial-sig qtvs, so they are -- not mono. Need to zonk them because they are meta-tyvar TyVarTvs - ; psig_qtvs <- zonkTcTyVarsToTcTyVars $ binderVars $ + ; psig_qtvs <- zonkTcTyVarsToTcTyVars $ binderVars $ concatMap (map snd . sig_inst_skols) psigs ; psig_theta <- mapM TcM.zonkTcType $ @@ -1713,29 +1720,31 @@ decideMonoTyVars infer_mode name_taus psigs candidates ; tc_lvl <- TcM.getTcLevel ; let psig_tys = mkTyVarTys psig_qtvs ++ psig_theta + -- (b) The co_var_tvs are tvs mentioned in the types of covars or + -- coercion holes. We can't quantify over these covars, so we + -- must include the variable in their types in the mono_tvs. + -- E.g. If we can't quantify over co :: k~Type, then we can't + -- quantify over k either! Hence closeOverKinds + -- Recall that coVarsOfTypes also returns coercion holes co_vars = coVarsOfTypes (psig_tys ++ taus ++ candidates) co_var_tvs = closeOverKinds co_vars - -- The co_var_tvs are tvs mentioned in the types of covars or - -- coercion holes. We can't quantify over these covars, so we - -- must include the variable in their types in the mono_tvs. - -- E.g. If we can't quantify over co :: k~Type, then we can't - -- quantify over k either! Hence closeOverKinds mono_tvs0 = filterVarSet (not . isQuantifiableTv tc_lvl) $ tyCoVarsOfTypes candidates -- We need to grab all the non-quantifiable tyvars in the -- types so that we can grow this set to find other - -- non-quantifiable tyvars. This can happen with something - -- like + -- non-quantifiable tyvars. This can happen with something like -- f x y = ... -- where z = x 3 -- The body of z tries to unify the type of x (call it alpha[1]) -- with (beta[2] -> gamma[2]). This unification fails because - -- alpha is untouchable. But we need to know not to quantify over - -- beta or gamma, because they are in the equality constraint with - -- alpha. Actual test case: typecheck/should_compile/tc213 + -- alpha is untouchable, leaving [W] alpha[1] ~ (beta[2] -> gamma[2]). + -- We need to know not to quantify over beta or gamma, because they + -- are in the equality constraint with alpha. Actual test case: + -- typecheck/should_compile/tc213 mono_tvs1 = mono_tvs0 `unionVarSet` co_var_tvs + -- mono_tvs1 is now the set of variables from an outer scope -- (that's mono_tvs0) and the set of covars, closed over kinds. -- Given this set of variables we know we will not quantify, @@ -1749,9 +1758,8 @@ decideMonoTyVars infer_mode name_taus psigs candidates -- (that is, we might have IP "c" Bool and IP "c" Int in different -- places within the same program), and -- skipping this causes implicit params to monomorphise too many - -- variables; see Note [Inheriting implicit parameters] in - -- GHC.Tc.Solver. Skipping causes typecheck/should_compile/tc219 - -- to fail. + -- variables; see Note [Inheriting implicit parameters] in GHC.Tc.Solver. + -- Skipping causes typecheck/should_compile/tc219 to fail. mono_tvs2 = closeWrtFunDeps non_ip_candidates mono_tvs1 -- mono_tvs2 now contains any variable determined by the "root @@ -1761,7 +1769,7 @@ decideMonoTyVars infer_mode name_taus psigs candidates closeWrtFunDeps non_ip_candidates (tyCoVarsOfTypes no_quant) `minusVarSet` mono_tvs2 -- constrained_tvs: the tyvars that we are not going to - -- quantify solely because of the monomorphism restriction + -- quantify /solely/ because of the monomorphism restriction -- -- (`minusVarSet` mono_tvs2): a type variable is only -- "constrained" (so that the MR bites) if it is not @@ -1783,7 +1791,12 @@ decideMonoTyVars infer_mode name_taus psigs candidates let dia = TcRnMonomorphicBindings (map fst name_taus) diagnosticTc (constrained_tvs `intersectsVarSet` tyCoVarsOfTypes taus) dia - ; traceTc "decideMonoTyVars" $ vcat + -- Promote the mono_tvs + -- See Note [Promote monomorphic tyvars] + ; traceTc "decidePromotedTyVars: promotion:" (ppr mono_tvs) + ; _ <- promoteTyVarSet mono_tvs + + ; traceTc "decidePromotedTyVars" $ vcat [ text "infer_mode =" <+> ppr infer_mode , text "mono_tvs0 =" <+> ppr mono_tvs0 , text "no_quant =" <+> ppr no_quant @@ -1791,7 +1804,7 @@ decideMonoTyVars infer_mode name_taus psigs candidates , text "mono_tvs =" <+> ppr mono_tvs , text "co_vars =" <+> ppr co_vars ] - ; return (mono_tvs, maybe_quant, co_vars) } + ; return (maybe_quant, co_vars) } where pick :: InferMode -> [PredType] -> TcM ([PredType], [PredType]) -- Split the candidates into ones we definitely @@ -1811,48 +1824,34 @@ decideMonoTyVars infer_mode name_taus psigs candidates ------------------- defaultTyVarsAndSimplify :: TcLevel - -> TyCoVarSet -- Promote these mono-tyvars -> [PredType] -- Assumed zonked -> TcM [PredType] -- Guaranteed zonked --- Promote the known-monomorphic tyvars; -- Default any tyvar free in the constraints; -- and re-simplify in case the defaulting allows further simplification -defaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates - = do { -- Promote any tyvars that we cannot generalise - -- See Note [Promote monomorphic tyvars] - ; traceTc "decideMonoTyVars: promotion:" (ppr mono_tvs) - ; _ <- promoteTyVarSet mono_tvs - - -- Default any kind/levity vars +defaultTyVarsAndSimplify rhs_tclvl candidates + = do { -- Default any kind/levity vars ; DV {dv_kvs = cand_kvs, dv_tvs = cand_tvs} <- candidateQTyVarsOfTypes candidates - -- any covars should already be handled by - -- the logic in decideMonoTyVars, which looks at - -- the constraints generated + -- NB1: decidePromotedTyVars has promoted any type variable fixed by the + -- type envt, so they won't be chosen by candidateQTyVarsOfTypes + -- NB2: Defaulting for variables free in tau_tys is done later, by quantifyTyVars + -- Hence looking only at 'candidates' + -- NB3: Any covars should already be handled by + -- the logic in decidePromotedTyVars, which looks at + -- the constraints generated ; poly_kinds <- xoptM LangExt.PolyKinds - ; mapM_ (default_one poly_kinds True) (dVarSetElems cand_kvs) - ; mapM_ (default_one poly_kinds False) (dVarSetElems (cand_tvs `minusDVarSet` cand_kvs)) + ; let default_kv | poly_kinds = default_tv + | otherwise = defaultTyVar DefaultKindVars + default_tv = defaultTyVar (NonStandardDefaulting DefaultNonStandardTyVars) + ; mapM_ default_kv (dVarSetElems cand_kvs) + ; mapM_ default_tv (dVarSetElems (cand_tvs `minusDVarSet` cand_kvs)) ; simplify_cand candidates } where - default_one poly_kinds is_kind_var tv - | not (isMetaTyVar tv) - = return () - | tv `elemVarSet` mono_tvs - = return () - | otherwise - = void $ defaultTyVar - (if not poly_kinds && is_kind_var - then DefaultKindVars - else NonStandardDefaulting DefaultNonStandardTyVars) - -- NB: only pass 'DefaultKindVars' when we know we're dealing with a kind variable. - tv - - -- this common case (no inferred constraints) should be fast - simplify_cand [] = return [] - -- see Note [Unconditionally resimplify constraints when quantifying] + -- See Note [Unconditionally resimplify constraints when quantifying] + simplify_cand [] = return [] -- Fast path simplify_cand candidates = do { clone_wanteds <- newWanteds DefaultOrigin candidates ; WC { wc_simple = simples } <- setTcLevel rhs_tclvl $ @@ -2086,7 +2085,7 @@ sure to quantify over them. This leads to several wrinkles: In the signature for 'g', we cannot quantify over 'b' because it turns out to get unified with 'a', which is free in g's environment. So we carefully - refrain from bogusly quantifying, in GHC.Tc.Solver.decideMonoTyVars. We + refrain from bogusly quantifying, in GHC.Tc.Solver.decidePromotedTyVars. We report the error later, in GHC.Tc.Gen.Bind.chooseInferredQuantifiers. Note [growThetaTyVars vs closeWrtFunDeps] @@ -2122,7 +2121,7 @@ constraint (transitively). We use closeWrtFunDeps in places where we need to know which variables are *always* determined by some seed set. This includes - * when determining the mono-tyvars in decideMonoTyVars. If `a` + * when determining the mono-tyvars in decidePromotedTyVars. If `a` is going to be monomorphic, we need b and c to be also: they are determined by the choice for `a`. * when checking instance coverage, in ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Tc.Types.Constraint ( assertFuelPrecondition, assertFuelPreconditionStrict, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, - isEmptyCts, + isEmptyCts, ctsPreds, isPendingScDict, pendingScDict_maybe, superClassesMightHelp, getPendingWantedScs, isWantedCt, isGivenCt, @@ -1043,6 +1043,9 @@ emptyCts = emptyBag isEmptyCts :: Cts -> Bool isEmptyCts = isEmptyBag +ctsPreds :: Cts -> [PredType] +ctsPreds cts = foldr ((:) . ctPred) [] cts + pprCts :: Cts -> SDoc pprCts cts = vcat (map ppr (bagToList cts)) ===================================== compiler/GHC/Tc/Utils/Concrete.hs ===================================== @@ -37,8 +37,12 @@ import GHC.Tc.Utils.TcMType ( newConcreteTyVar, isFilledMetaTyVar_maybe, writ , emitWantedEq ) import GHC.Types.Basic ( TypeOrKind(..) ) +import GHC.Types.Name ( getOccName ) +import GHC.Types.Name.Occurrence( occNameFS ) import GHC.Utils.Misc ( HasDebugCallStack ) import GHC.Utils.Outputable +import GHC.Data.FastString ( fsLit ) + import Control.Monad ( void ) import Data.Functor ( ($>) ) @@ -495,7 +499,7 @@ unifyConcrete frr_orig ty -- Create a new ConcreteTv metavariable @concrete_tv@ -- and unify @ty ~# concrete_tv at . ; _ -> - do { conc_tv <- newConcreteTyVar (ConcreteFRR frr_orig) ki + do { conc_tv <- newConcreteTyVar (ConcreteFRR frr_orig) (fsLit "cx") ki -- NB: newConcreteTyVar asserts that 'ki' is concrete. ; coToMCo <$> emitWantedEq orig KindLevel Nominal ty (mkTyVarTy conc_tv) } } } where @@ -647,9 +651,12 @@ makeTypeConcrete conc_orig ty = , TauTv <- metaTyVarInfo tv -> -- Change the MetaInfo to ConcreteTv, but retain the TcLevel do { kind <- go (tyVarKind tv) + ; let occ_fs = occNameFS (getOccName tv) + -- occ_fs: preserve the occurrence name of the original tyvar + -- This helps in error messages ; lift $ do { conc_tv <- setTcLevel (tcTyVarLevel tv) $ - newConcreteTyVar conc_orig kind + newConcreteTyVar conc_orig occ_fs kind ; let conc_ty = mkTyVarTy conc_tv ; writeMetaTyVar tv conc_ty ; return conc_ty } } ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -45,8 +45,6 @@ module GHC.Tc.Utils.TcMType ( unpackCoercionHole, unpackCoercionHole_maybe, checkCoercionHole, - ConcreteHole, newConcreteHole, - newImplication, -------------------------------- @@ -414,23 +412,6 @@ checkCoercionHole cv co | otherwise = False --- | A coercion hole used to store evidence for `Concrete#` constraints. --- --- See Note [The Concrete mechanism]. -type ConcreteHole = CoercionHole - --- | Create a new (initially unfilled) coercion hole, --- to hold evidence for a @'Concrete#' (ty :: ki)@ constraint. -newConcreteHole :: Kind -- ^ Kind of the thing we want to ensure is concrete (e.g. 'runtimeRepTy') - -> Type -- ^ Thing we want to ensure is concrete (e.g. some 'RuntimeRep') - -> TcM (ConcreteHole, TcType) - -- ^ where to put the evidence, and a metavariable to store - -- the concrete type -newConcreteHole ki ty - = do { concrete_ty <- newFlexiTyVarTy ki - ; let co_ty = mkHeteroPrimEqPred ki ki ty concrete_ty - ; hole <- newCoercionHole co_ty - ; return (hole, concrete_ty) } {- ********************************************************************** * @@ -840,11 +821,13 @@ cloneTyVarTyVar name kind -- -- Invariant: the kind must be concrete, as per Note [ConcreteTv]. -- This is checked with an assertion. -newConcreteTyVar :: HasDebugCallStack => ConcreteTvOrigin -> TcKind -> TcM TcTyVar -newConcreteTyVar reason kind = - assertPpr (isConcrete kind) - (text "newConcreteTyVar: non-concrete kind" <+> ppr kind) - $ newAnonMetaTyVar (ConcreteTv reason) kind +newConcreteTyVar :: HasDebugCallStack => ConcreteTvOrigin + -> FastString -> TcKind -> TcM TcTyVar +newConcreteTyVar reason fs kind + = assertPpr (isConcrete kind) assert_msg $ + newNamedAnonMetaTyVar fs (ConcreteTv reason) kind + where + assert_msg = text "newConcreteTyVar: non-concrete kind" <+> ppr kind newPatSigTyVar :: Name -> Kind -> TcM TcTyVar newPatSigTyVar name kind @@ -1242,14 +1225,14 @@ NB: this is all rather similar to, but sadly not the same as Wrinkle: -We must make absolutely sure that alpha indeed is not -from an outer context. (Otherwise, we might indeed learn more information -about it.) This can be done easily: we just check alpha's TcLevel. -That level must be strictly greater than the ambient TcLevel in order -to treat it as naughty. We say "strictly greater than" because the call to +We must make absolutely sure that alpha indeed is not from an outer +context. (Otherwise, we might indeed learn more information about it.) +This can be done easily: we just check alpha's TcLevel. That level +must be strictly greater than the ambient TcLevel in order to treat it +as naughty. We say "strictly greater than" because the call to candidateQTyVars is made outside the bumped TcLevel, as stated in the -comment to candidateQTyVarsOfType. The level check is done in go_tv -in collect_cand_qtvs. Skipping this check caused #16517. +comment to candidateQTyVarsOfType. The level check is done in go_tv in +collect_cand_qtvs. Skipping this check caused #16517. -} @@ -1349,8 +1332,9 @@ candidateQTyVarsWithBinders :: [TyVar] -> Type -> TcM CandidatesQTvs -- Because we are going to scoped-sort the quantified variables -- in among the tvs candidateQTyVarsWithBinders bound_tvs ty - = do { kvs <- candidateQTyVarsOfKinds (map tyVarKind bound_tvs) - ; all_tvs <- collect_cand_qtvs ty False emptyVarSet kvs ty + = do { kvs <- candidateQTyVarsOfKinds (map tyVarKind bound_tvs) + ; cur_lvl <- getTcLevel + ; all_tvs <- collect_cand_qtvs ty False cur_lvl emptyVarSet kvs ty ; return (all_tvs `delCandidates` bound_tvs) } -- | Gathers free variables to use as quantification candidates (in @@ -1362,14 +1346,18 @@ candidateQTyVarsWithBinders bound_tvs ty -- See Note [Dependent type variables] candidateQTyVarsOfType :: TcType -- not necessarily zonked -> TcM CandidatesQTvs -candidateQTyVarsOfType ty = collect_cand_qtvs ty False emptyVarSet mempty ty +candidateQTyVarsOfType ty + = do { cur_lvl <- getTcLevel + ; collect_cand_qtvs ty False cur_lvl emptyVarSet mempty ty } -- | Like 'candidateQTyVarsOfType', but over a list of types -- The variables to quantify must have a TcLevel strictly greater than -- the ambient level. (See Wrinkle in Note [Naughty quantification candidates]) candidateQTyVarsOfTypes :: [Type] -> TcM CandidatesQTvs -candidateQTyVarsOfTypes tys = foldlM (\acc ty -> collect_cand_qtvs ty False emptyVarSet acc ty) - mempty tys +candidateQTyVarsOfTypes tys + = do { cur_lvl <- getTcLevel + ; foldlM (\acc ty -> collect_cand_qtvs ty False cur_lvl emptyVarSet acc ty) + mempty tys } -- | Like 'candidateQTyVarsOfType', but consider every free variable -- to be dependent. This is appropriate when generalizing a *kind*, @@ -1377,16 +1365,21 @@ candidateQTyVarsOfTypes tys = foldlM (\acc ty -> collect_cand_qtvs ty False empt -- to Type.) candidateQTyVarsOfKind :: TcKind -- Not necessarily zonked -> TcM CandidatesQTvs -candidateQTyVarsOfKind ty = collect_cand_qtvs ty True emptyVarSet mempty ty +candidateQTyVarsOfKind ty + = do { cur_lvl <- getTcLevel + ; collect_cand_qtvs ty True cur_lvl emptyVarSet mempty ty } candidateQTyVarsOfKinds :: [TcKind] -- Not necessarily zonked -> TcM CandidatesQTvs -candidateQTyVarsOfKinds tys = foldM (\acc ty -> collect_cand_qtvs ty True emptyVarSet acc ty) - mempty tys +candidateQTyVarsOfKinds tys + = do { cur_lvl <- getTcLevel + ; foldM (\acc ty -> collect_cand_qtvs ty True cur_lvl emptyVarSet acc ty) + mempty tys } collect_cand_qtvs - :: TcType -- original type that we started recurring into; for errors + :: TcType -- Original type that we started recurring into; for errors -> Bool -- True <=> consider every fv in Type to be dependent + -> TcLevel -- Current TcLevel; collect only tyvars whose level is greater -> VarSet -- Bound variables (locals only) -> CandidatesQTvs -- Accumulating parameter -> Type -- Not necessarily zonked @@ -1403,7 +1396,7 @@ collect_cand_qtvs -- so that subsequent dependency analysis (to build a well -- scoped telescope) works correctly -collect_cand_qtvs orig_ty is_dep bound dvs ty +collect_cand_qtvs orig_ty is_dep cur_lvl bound dvs ty = go dvs ty where is_bound tv = tv `elemVarSet` bound @@ -1411,13 +1404,13 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty ----------------- go :: CandidatesQTvs -> TcType -> TcM CandidatesQTvs -- Uses accumulating-parameter style - go dv (AppTy t1 t2) = foldlM go dv [t1, t2] - go dv (TyConApp tc tys) = go_tc_args dv (tyConBinders tc) tys + go dv (AppTy t1 t2) = foldlM go dv [t1, t2] + go dv (TyConApp tc tys) = go_tc_args dv (tyConBinders tc) tys go dv (FunTy _ w arg res) = foldlM go dv [w, arg, res] - go dv (LitTy {}) = return dv - go dv (CastTy ty co) = do dv1 <- go dv ty - collect_cand_qtvs_co orig_ty bound dv1 co - go dv (CoercionTy co) = collect_cand_qtvs_co orig_ty bound dv co + go dv (LitTy {}) = return dv + go dv (CastTy ty co) = do { dv1 <- go dv ty + ; collect_cand_qtvs_co orig_ty cur_lvl bound dv1 co } + go dv (CoercionTy co) = collect_cand_qtvs_co orig_ty cur_lvl bound dv co go dv (TyVarTy tv) | is_bound tv = return dv @@ -1427,8 +1420,8 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty Nothing -> go_tv dv tv } go dv (ForAllTy (Bndr tv _) ty) - = do { dv1 <- collect_cand_qtvs orig_ty True bound dv (tyVarKind tv) - ; collect_cand_qtvs orig_ty is_dep (bound `extendVarSet` tv) dv1 ty } + = do { dv1 <- collect_cand_qtvs orig_ty True cur_lvl bound dv (tyVarKind tv) + ; collect_cand_qtvs orig_ty is_dep cur_lvl (bound `extendVarSet` tv) dv1 ty } -- This makes sure that we default e.g. the alpha in Proxy alpha (Any alpha). -- Tested in polykinds/NestedProxies. @@ -1437,7 +1430,7 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty -- to look at kinds. go_tc_args dv (tc_bndr:tc_bndrs) (ty:tys) = do { dv1 <- collect_cand_qtvs orig_ty (is_dep || isNamedTyConBinder tc_bndr) - bound dv ty + cur_lvl bound dv ty ; go_tc_args dv1 tc_bndrs tys } go_tc_args dv _bndrs tys -- _bndrs might be non-empty: undersaturation -- tys might be non-empty: oversaturation @@ -1446,6 +1439,21 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty ----------------- go_tv dv@(DV { dv_kvs = kvs, dv_tvs = tvs }) tv + | tcTyVarLevel tv <= cur_lvl + = return dv -- This variable is from an outer context; skip + -- See Note [Use level numbers for quantification] + + | case tcTyVarDetails tv of + SkolemTv _ lvl _ -> lvl > pushTcLevel cur_lvl + _ -> False + = return dv -- Skip inner skolems + -- This only happens for erroneous program with bad telescopes + -- e.g. BadTelescope2: forall a k (b :: k). SameKind a b + -- We have (a::k), and at the outer we don't want to quantify + -- over the already-quantified skolem k. + -- (Apparently we /do/ want to quantify over skolems whose level sk_lvl is + -- sk_lvl > cur_lvl; you get lots of failures otherwise. A battle for another day.) + | tv `elemDVarSet` kvs = return dv -- We have met this tyvar already @@ -1461,17 +1469,7 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty -- (which comes next) works correctly ; let tv_kind_vars = tyCoVarsOfType tv_kind - ; cur_lvl <- getTcLevel - ; if | tcTyVarLevel tv <= cur_lvl - -> return dv -- this variable is from an outer context; skip - -- See Note [Use level numbers for quantification] - - | case tcTyVarDetails tv of - SkolemTv _ lvl _ -> lvl > pushTcLevel cur_lvl - _ -> False - -> return dv -- Skip inner skolems; ToDo: explain - - | intersectsVarSet bound tv_kind_vars + ; if | intersectsVarSet bound tv_kind_vars -- the tyvar must not be from an outer context, but we have -- already checked for this. -- See Note [Naughty quantification candidates] @@ -1490,25 +1488,26 @@ collect_cand_qtvs orig_ty is_dep bound dvs ty -- See Note [Order of accumulation] -- See Note [Recurring into kinds for candidateQTyVars] - ; collect_cand_qtvs orig_ty True bound dv' tv_kind } } + ; collect_cand_qtvs orig_ty True cur_lvl bound dv' tv_kind } } collect_cand_qtvs_co :: TcType -- original type at top of recursion; for errors + -> TcLevel -> VarSet -- bound variables -> CandidatesQTvs -> Coercion -> TcM CandidatesQTvs -collect_cand_qtvs_co orig_ty bound = go_co +collect_cand_qtvs_co orig_ty cur_lvl bound = go_co where - go_co dv (Refl ty) = collect_cand_qtvs orig_ty True bound dv ty - go_co dv (GRefl _ ty mco) = do dv1 <- collect_cand_qtvs orig_ty True bound dv ty - go_mco dv1 mco + go_co dv (Refl ty) = collect_cand_qtvs orig_ty True cur_lvl bound dv ty + go_co dv (GRefl _ ty mco) = do { dv1 <- collect_cand_qtvs orig_ty True cur_lvl bound dv ty + ; go_mco dv1 mco } go_co dv (TyConAppCo _ _ cos) = foldlM go_co dv cos go_co dv (AppCo co1 co2) = foldlM go_co dv [co1, co2] go_co dv (FunCo _ _ _ w co1 co2) = foldlM go_co dv [w, co1, co2] go_co dv (AxiomInstCo _ _ cos) = foldlM go_co dv cos go_co dv (AxiomRuleCo _ cos) = foldlM go_co dv cos - go_co dv (UnivCo prov _ t1 t2) = do dv1 <- go_prov dv prov - dv2 <- collect_cand_qtvs orig_ty True bound dv1 t1 - collect_cand_qtvs orig_ty True bound dv2 t2 + go_co dv (UnivCo prov _ t1 t2) = do { dv1 <- go_prov dv prov + ; dv2 <- collect_cand_qtvs orig_ty True cur_lvl bound dv1 t1 + ; collect_cand_qtvs orig_ty True cur_lvl bound dv2 t2 } go_co dv (SymCo co) = go_co dv co go_co dv (TransCo co1 co2) = foldlM go_co dv [co1, co2] go_co dv (SelCo _ co) = go_co dv co @@ -1527,7 +1526,7 @@ collect_cand_qtvs_co orig_ty bound = go_co go_co dv (ForAllCo tcv kind_co co) = do { dv1 <- go_co dv kind_co - ; collect_cand_qtvs_co orig_ty (bound `extendVarSet` tcv) dv1 co } + ; collect_cand_qtvs_co orig_ty cur_lvl (bound `extendVarSet` tcv) dv1 co } go_mco dv MRefl = return dv go_mco dv (MCo co) = go_co dv co @@ -1543,7 +1542,7 @@ collect_cand_qtvs_co orig_ty bound = go_co | cv `elemVarSet` cvs = return dv -- See Note [Recurring into kinds for candidateQTyVars] - | otherwise = collect_cand_qtvs orig_ty True bound + | otherwise = collect_cand_qtvs orig_ty True cur_lvl bound (dv { dv_cvs = cvs `extendVarSet` cv }) (idType cv) @@ -1810,17 +1809,30 @@ defaultTyVar def_strat tv = do { traceTc "Defaulting a RuntimeRep var to LiftedRep" (ppr tv) ; writeMetaTyVar tv liftedRepTy ; return True } + | isLevityVar tv , default_ns_vars = do { traceTc "Defaulting a Levity var to Lifted" (ppr tv) ; writeMetaTyVar tv liftedDataConTy ; return True } + | isMultiplicityVar tv , default_ns_vars = do { traceTc "Defaulting a Multiplicity var to Many" (ppr tv) ; writeMetaTyVar tv manyDataConTy ; return True } + | isConcreteTyVar tv + -- We don't want to quantify; but neither can we default to + -- anything sensible. (If it has kind RuntimeRep or Levity, as is + -- often the case, it'll have been caught earlier by earlier + -- cases. So in this exotic situation we just promote. Not very + -- satisfing, but it's very much a corner case: #23051 + -- We should really implement the plan in #20686. + = do { lvl <- getTcLevel + ; _ <- promoteMetaTyVarTo lvl tv + ; return True } + | DefaultKindVars <- def_strat -- -XNoPolyKinds and this is a kind var: we must default it = default_kind_var tv @@ -1872,9 +1884,8 @@ defaultTyVars ns_strat dvs ; let def_tvs, def_kvs :: DefaultingStrategy def_tvs = NonStandardDefaulting ns_strat - def_kvs - | poly_kinds = def_tvs - | otherwise = DefaultKindVars + def_kvs | poly_kinds = def_tvs + | otherwise = DefaultKindVars -- As -XNoPolyKinds precludes polymorphic kind variables, we default them. -- For example: -- @@ -1965,7 +1976,7 @@ What do do? D. We could error. We choose (D), as described in #17567, and implement this choice in -doNotQuantifyTyVars. Discussion of alternativs A-C is below. +doNotQuantifyTyVars. Discussion of alternatives A-C is below. NB: this is all rather similar to, but sadly not the same as Note [Naughty quantification candidates] ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -475,7 +475,7 @@ This is not OK: we get MkT :: forall l. T @l :: TYPE (BoxedRep l) which is ill-kinded. -For ordinary /user-written type signatures f :: blah, we make this +For ordinary /user-written/ type signatures f :: blah, we make this check as part of kind-checking the type signature in tcHsSigType; see Note [Escaping kind in type signatures] in GHC.Tc.Gen.HsType. ===================================== testsuite/tests/rep-poly/RepPolyArgument.stderr ===================================== @@ -3,8 +3,8 @@ RepPolyArgument.hs:10:18: error: [GHC-55287] • The argument ‘(undefined @(R @RuntimeRep))’ of ‘undefined’ does not have a fixed runtime representation. Its type is: - t0 :: TYPE c0 - Cannot unify ‘R’ with the type variable ‘c0’ + t1 :: TYPE t0 + Cannot unify ‘R’ with the type variable ‘t0’ because it is not a concrete ‘RuntimeRep’. • In the first argument of ‘undefined’, namely ‘(undefined @(R @RuntimeRep))’ ===================================== testsuite/tests/rep-poly/RepPolyDoBind.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyDoBind.hs:26:3: error: [GHC-55287] arising from a do statement does not have a fixed runtime representation. Its type is: - ma0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + ma0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a 'do' block: a <- undefined In the expression: ===================================== testsuite/tests/rep-poly/RepPolyDoBody1.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyDoBody1.hs:24:3: error: [GHC-55287] arising from a do statement does not have a fixed runtime representation. Its type is: - ma0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + ma0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a 'do' block: undefined :: ma In the expression: ===================================== testsuite/tests/rep-poly/RepPolyDoBody2.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyDoBody2.hs:23:3: error: [GHC-55287] arising from a do statement does not have a fixed runtime representation. Its type is: - mb0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + mb0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a 'do' block: undefined :: () In the expression: ===================================== testsuite/tests/rep-poly/RepPolyLeftSection2.stderr ===================================== @@ -3,8 +3,8 @@ RepPolyLeftSection2.hs:14:11: error: [GHC-55287] • The argument ‘undefined’ of ‘f’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ + a0 :: TYPE r0 + Cannot unify ‘r’ with the type variable ‘r0’ because it is not a concrete ‘RuntimeRep’. • In the expression: undefined `f` In an equation for ‘test1’: test1 = (undefined `f`) ===================================== testsuite/tests/rep-poly/RepPolyMcBind.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyMcBind.hs:26:16: error: [GHC-55287] arising from a statement in a monad comprehension does not have a fixed runtime representation. Its type is: - ma0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + ma0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a monad comprehension: x <- undefined :: ma In the expression: [() | x <- undefined :: ma] ===================================== testsuite/tests/rep-poly/RepPolyMcBody.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyMcBody.hs:30:16: error: [GHC-55287] arising from a statement in a monad comprehension does not have a fixed runtime representation. Its type is: - ma0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + ma0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a monad comprehension: True In the expression: [() | True] ===================================== testsuite/tests/rep-poly/RepPolyMcGuard.stderr ===================================== @@ -4,8 +4,8 @@ RepPolyMcGuard.hs:30:16: error: [GHC-55287] arising from a statement in a monad comprehension does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + a0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a stmt of a monad comprehension: undefined In the expression: [() | undefined] ===================================== testsuite/tests/rep-poly/RepPolyNPlusK.stderr ===================================== @@ -3,4 +3,4 @@ RepPolyNPlusK.hs:22:1: error: [GHC-55287] The first pattern in the equation for ‘foo’ does not have a fixed runtime representation. Its type is: - a :: TYPE rep1 + a :: TYPE rep2 ===================================== testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr ===================================== @@ -17,8 +17,8 @@ RepPolyRecordUpdate.hs:13:9: error: [GHC-55287] • The record update at field ‘fld’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c1 - Cannot unify ‘rep’ with the type variable ‘c1’ + a0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In a record update at field ‘fld’, with type constructor ‘X’ ===================================== testsuite/tests/rep-poly/RepPolyRule1.stderr ===================================== @@ -3,8 +3,8 @@ RepPolyRule1.hs:11:51: error: [GHC-55287] • The argument ‘x’ of ‘f’ does not have a fixed runtime representation. Its type is: - a1 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + a1 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In the first argument of ‘f’, namely ‘x’ In the expression: f x @@ -16,8 +16,8 @@ RepPolyRule1.hs:11:55: error: [GHC-55287] • The argument ‘x’ of ‘f’ does not have a fixed runtime representation. Its type is: - a1 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + a1 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In the expression: x When checking the rewrite rule "f_id" ===================================== testsuite/tests/rep-poly/RepPolyTupleSection.stderr ===================================== @@ -3,8 +3,8 @@ RepPolyTupleSection.hs:11:7: error: [GHC-55287] • The second component of the tuple section does not have a fixed runtime representation. Its type is: - t0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ + t1 :: TYPE t0 + Cannot unify ‘r’ with the type variable ‘t0’ because it is not a concrete ‘RuntimeRep’. • In the expression: (# 3#, #) In an equation for ‘foo’: foo = (# 3#, #) ===================================== testsuite/tests/rep-poly/T12709.stderr ===================================== @@ -3,8 +3,8 @@ T12709.hs:28:13: error: [GHC-55287] • The argument ‘1’ of ‘(+)’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ + a0 :: TYPE rep0 + Cannot unify ‘rep’ with the type variable ‘rep0’ because it is not a concrete ‘RuntimeRep’. • In the expression: 1 + 2 + 3 + 4 In an equation for ‘u’: u = 1 + 2 + 3 + 4 ===================================== testsuite/tests/rep-poly/T12973.stderr ===================================== @@ -3,8 +3,8 @@ T12973.hs:13:7: error: [GHC-55287] • The argument ‘3’ of ‘(+)’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ + a0 :: TYPE r0 + Cannot unify ‘r’ with the type variable ‘r0’ because it is not a concrete ‘RuntimeRep’. • In the expression: 3 + 4 In an equation for ‘foo’: foo = 3 + 4 ===================================== testsuite/tests/rep-poly/T13929.stderr ===================================== @@ -3,8 +3,8 @@ T13929.hs:29:24: error: [GHC-55287] • The tuple argument in first position does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘rf’ with the type variable ‘c0’ + a0 :: TYPE k00 + Cannot unify ‘rf’ with the type variable ‘k00’ because it is not a concrete ‘RuntimeRep’. • In the expression: (# gunbox x, gunbox y #) In an equation for ‘gunbox’: ===================================== testsuite/tests/rep-poly/T19615.stderr ===================================== @@ -3,8 +3,8 @@ T19615.hs:17:21: error: [GHC-55287] • The argument ‘(f x)’ of ‘lift'’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r'’ with the type variable ‘c0’ + a0 :: TYPE r0 + Cannot unify ‘r'’ with the type variable ‘r0’ because it is not a concrete ‘RuntimeRep’. • In the first argument of ‘lift'’, namely ‘(f x)’ In the expression: lift' (f x) id ===================================== testsuite/tests/rep-poly/T19709b.stderr ===================================== @@ -3,8 +3,8 @@ T19709b.hs:11:15: error: [GHC-55287] • The argument ‘(error @Any "e2")’ of ‘levfun’ does not have a fixed runtime representation. Its type is: - a1 :: TYPE c0 - Cannot unify ‘Any’ with the type variable ‘c0’ + a1 :: TYPE r0 + Cannot unify ‘Any’ with the type variable ‘r0’ because it is not a concrete ‘RuntimeRep’. • In the first argument of ‘levfun’, namely ‘(error @Any "e2")’ In the first argument of ‘seq’, namely ‘levfun (error @Any "e2")’ ===================================== testsuite/tests/rep-poly/T23051.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash #-} +module M where + +import GHC.Exts + +i :: forall k (f :: k -> RuntimeRep) (g :: k) (a :: TYPE (f g)). a -> a +i = i + +x = i 0# ===================================== testsuite/tests/rep-poly/T23051.stderr ===================================== @@ -0,0 +1,10 @@ + +T23051.hs:9:7: error: [GHC-18872] + • Couldn't match kind ‘IntRep’ with ‘f0 g0’ + When matching types + a :: TYPE (f0 g0) + Int# :: TYPE IntRep + • In the first argument of ‘i’, namely ‘0#’ + In the expression: i 0# + In an equation for ‘x’: x = i 0# + • Relevant bindings include x :: a (bound at T23051.hs:9:1) ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -113,3 +113,6 @@ test('RepPolyTuple2', normal, compile_fail, ['']) ## see #21683 ## test('T21650_a', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## ############################################################################### + + +test('T23051', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/926ad6ded5cb5e8162914e746ee001fc8d1658ec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/926ad6ded5cb5e8162914e746ee001fc8d1658ec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 05:04:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 22 Mar 2023 01:04:02 -0400 Subject: [Git][ghc/ghc][master] Testsuite: use appropriate predicate for ManyUbxSums test (#22576) Message-ID: <641a8c421e397_90da2a20cae0499648@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 1 changed file: - testsuite/tests/unboxedsums/all.T Changes: ===================================== testsuite/tests/unboxedsums/all.T ===================================== @@ -59,7 +59,7 @@ test('T22208', normal, compile, ['-dstg-lint -dcmm-lint']) test('ManyUbxSums', [ pre_cmd('{compiler} --run ./GenManyUbxSums.hs'), extra_files(['GenManyUbxSums.hs', 'ManyUbxSums_Addr.hs']), - js_broken(22576) + req_interp ], multi_compile_and_run, ['ManyUbxSums', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ab0cc119c6d222d50e0970fddb679a6eeef80de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ab0cc119c6d222d50e0970fddb679a6eeef80de You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 05:04:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 22 Mar 2023 01:04:41 -0400 Subject: [Git][ghc/ghc][master] fix: Incorrect @since annotations in GHC.TypeError Message-ID: <641a8c69a41c1_90da2a3881bc5047fe@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - 2 changed files: - libraries/base/GHC/TypeError.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/GHC/TypeError.hs ===================================== @@ -12,7 +12,7 @@ This module exports the TypeError family, which is used to provide custom type errors, and the ErrorMessage kind used to define these custom error messages. This is a type-level analogue to the term level error function. - at since 4.16.0.0 + at since 4.17.0.0 -} module GHC.TypeError @@ -132,7 +132,7 @@ equation of Assert kicks in, and -- where @NotPError@ reduces to a @TypeError@ which is reported if the -- assertion fails. -- --- @since 4.16.0.0 +-- @since 4.17.0.0 -- type Assert :: Bool -> Constraint -> Constraint type family Assert check errMsg where ===================================== libraries/base/changelog.md ===================================== @@ -168,6 +168,9 @@ errors. `TypeError` is re-exported from `GHC.TypeLits` for backwards compatibility. + * Comparison constraints in `Data.Type.Ord` (e.g. `<=`) now use the new + `GHC.TypeError.Assert` type family instead of type equality with `~`. + ## 4.16.3.0 *May 2022* * Shipped with GHC 9.2.4 @@ -245,9 +248,6 @@ * `fromInteger :: Integer -> Float/Double` now consistently round to the nearest value, with ties to even. - * Comparison constraints in `Data.Type.Ord` (e.g. `<=`) now use the new - `GHC.TypeError.Assert` type family instead of type equality with `~`. - * Additions to `Data.Bits`: - Newtypes `And`, `Ior`, `Xor` and `Iff` which wrap their argument, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/048c881ee5b11716e37cebe43f2d2eac878c04fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/048c881ee5b11716e37cebe43f2d2eac878c04fb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 05:05:20 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 22 Mar 2023 01:05:20 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Testsuite: use req_interp predicate for T16318 (#22370) Message-ID: <641a8c90dff49_90da29ef95745078a1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - 2 changed files: - testsuite/tests/driver/T16318/all.T - testsuite/tests/ghci/should_fail/all.T Changes: ===================================== testsuite/tests/driver/T16318/all.T ===================================== @@ -1 +1 @@ -test('T16318', js_broken(22370), makefile_test, []) +test('T16318', req_interp, makefile_test, []) ===================================== testsuite/tests/ghci/should_fail/all.T ===================================== @@ -5,4 +5,4 @@ test('T16013', [], ghci_script, ['T16013.script']) test('T16287', [], ghci_script, ['T16287.script']) test('T18052b', [], ghci_script, ['T18052b.script']) test('T18027a', [], ghci_script, ['T18027a.script']) -test('T20214', js_broken(22370), makefile_test, ['T20214']) +test('T20214', req_interp, makefile_test, ['T20214']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/048c881ee5b11716e37cebe43f2d2eac878c04fb...ad765b6f0bb23576fb4e7690a29fa07fc1dfff11 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/048c881ee5b11716e37cebe43f2d2eac878c04fb...ad765b6f0bb23576fb4e7690a29fa07fc1dfff11 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 09:48:47 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 22 Mar 2023 05:48:47 -0400 Subject: [Git][ghc/ghc][wip/T23070] 6 commits: Be more careful about quantification Message-ID: <641aceff5b0c9_90da2ebbc1b8525411@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23070 at Glasgow Haskell Compiler / GHC Commits: 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - 5 changed files: - compiler/GHC/Data/Bag.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/37faaad4c63183866dd6ef6ba0dc5e8b37d19bed...e0b8eaf3fc3d2ebbdcc86610b889930dbe5b4cdb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/37faaad4c63183866dd6ef6ba0dc5e8b37d19bed...e0b8eaf3fc3d2ebbdcc86610b889930dbe5b4cdb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 10:04:08 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 22 Mar 2023 06:04:08 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23153 Message-ID: <641ad298332f2_90da2f22818c5280ba@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T23153 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23153 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 11:36:33 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 22 Mar 2023 07:36:33 -0400 Subject: [Git][ghc/ghc][wip/jsem] Implement -jsem: parallelism controlled by semaphores Message-ID: <641ae8414e340_90da30bc403c56158a@gitlab.mail> Matthew Pickering pushed to branch wip/jsem at Glasgow Haskell Compiler / GHC Commits: 1755da7f by sheaf at 2023-03-22T11:36:12+00:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Fixes #19349 - - - - - 13 changed files: - .gitmodules - cabal.project-reinstall - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/ghc.cabal.in - docs/users_guide/using.rst - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - + libraries/semaphore-compat - packages Changes: ===================================== .gitmodules ===================================== @@ -83,6 +83,10 @@ url = https://gitlab.haskell.org/ghc/packages/unix.git ignore = untracked branch = 2.7 +[submodule "libraries/semaphore-compat"] + path = libraries/semaphore-compat + url = https://gitlab.haskell.org/ghc/semaphore-compat.git + ignore = untracked [submodule "libraries/stm"] path = libraries/stm url = https://gitlab.haskell.org/ghc/packages/stm.git ===================================== cabal.project-reinstall ===================================== @@ -28,6 +28,7 @@ packages: ./compiler ./libraries/parsec/ -- ./libraries/pretty/ ./libraries/process/ + ./libraries/semaphore-compat ./libraries/stm -- ./libraries/template-haskell/ ./libraries/terminfo/ ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -75,6 +75,7 @@ import GHC.Driver.Env import GHC.Driver.Errors import GHC.Driver.Errors.Types import GHC.Driver.Main +import GHC.Driver.MakeSem import GHC.Parser.Header @@ -149,9 +150,9 @@ import GHC.Runtime.Loader import GHC.Rename.Names import GHC.Utils.Constants import GHC.Types.Unique.DFM (udfmRestrictKeysSet) -import qualified Data.IntSet as I import GHC.Types.Unique +import qualified Data.IntSet as I -- ----------------------------------------------------------------------------- -- Loading the program @@ -657,6 +658,30 @@ createBuildPlan mod_graph maybe_top_mod = (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (length (mgModSummaries' mod_graph )))]) build_plan +mkWorkerLimit :: DynFlags -> IO WorkerLimit +mkWorkerLimit dflags = + case parMakeCount dflags of + Nothing -> pure $ num_procs 1 + Just (ParMakeSemaphore h) -> pure (JSemLimit (SemaphoreName h)) + Just ParMakeNumProcessors -> num_procs <$> getNumProcessors + Just (ParMakeThisMany n) -> pure $ num_procs n + where + num_procs x = NumProcessorsLimit (max 1 x) + +isWorkerLimitSequential :: WorkerLimit -> Bool +isWorkerLimitSequential (NumProcessorsLimit x) = x <= 1 +isWorkerLimitSequential (JSemLimit {}) = False + +-- | This describes what we use to limit the number of jobs, either we limit it +-- ourselves to a specific number or we have an external parallelism semaphore +-- limit it for us. +data WorkerLimit + = NumProcessorsLimit Int + | JSemLimit + SemaphoreName + -- ^ Semaphore name to use + deriving Eq + -- | Generalized version of 'load' which also supports a custom -- 'Messager' (for reporting progress) and 'ModuleGraph' (generally -- produced by calling 'depanal'. @@ -737,14 +762,12 @@ load' mhmi_cache how_much mHscMessage mod_graph = do liftIO $ debugTraceMsg logger 2 (hang (text "Ready for upsweep") 2 (ppr build_plan)) - n_jobs <- case parMakeCount (hsc_dflags hsc_env) of - Nothing -> liftIO getNumProcessors - Just n -> return n + worker_limit <- liftIO $ mkWorkerLimit dflags setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do hsc_env <- getSession - liftIO $ upsweep n_jobs hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan + liftIO $ upsweep worker_limit hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan setSession hsc_env1 case upsweep_ok of Failed -> loadFinish upsweep_ok @@ -1029,13 +1052,7 @@ getDependencies direct_deps build_map = type BuildM a = StateT BuildLoopState IO a --- | Abstraction over the operations of a semaphore which allows usage with the --- -j1 case -data AbstractSem = AbstractSem { acquireSem :: IO () - , releaseSem :: IO () } -withAbstractSem :: AbstractSem -> IO b -> IO b -withAbstractSem sem = MC.bracket_ (acquireSem sem) (releaseSem sem) -- | Environment used when compiling a module data MakeEnv = MakeEnv { hsc_env :: !HscEnv -- The basic HscEnv which will be augmented for each module @@ -1220,7 +1237,7 @@ withCurrentUnit uid = do local (\env -> env { hsc_env = hscSetActiveUnitId uid (hsc_env env)}) upsweep - :: Int -- ^ The number of workers we wish to run in parallel + :: WorkerLimit -- ^ The number of workers we wish to run in parallel -> HscEnv -- ^ The base HscEnv, which is augmented for each module -> Maybe ModIfaceCache -- ^ A cache to incrementally write final interface files to -> Maybe Messager @@ -2825,7 +2842,7 @@ label_self thread_name = do CC.labelThread self_tid thread_name -runPipelines :: Int -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () +runPipelines :: WorkerLimit -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () -- Don't even initialise plugins if there are no pipelines runPipelines _ _ _ [] = return () runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do @@ -2833,7 +2850,7 @@ runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do plugins_hsc_env <- initializePlugins orig_hsc_env case n_job of - 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines + NumProcessorsLimit n | n <= 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines _n -> runParPipelines n_job plugins_hsc_env mHscMessager all_pipelines runSeqPipelines :: HscEnv -> Maybe Messager -> [MakeAction] -> IO () @@ -2843,16 +2860,38 @@ runSeqPipelines plugin_hsc_env mHscMessager all_pipelines = , compile_sem = AbstractSem (return ()) (return ()) , env_messager = mHscMessager } - in runAllPipelines 1 env all_pipelines + in runAllPipelines (NumProcessorsLimit 1) env all_pipelines +runNjobsAbstractSem :: Int -> (AbstractSem -> IO a) -> IO a +runNjobsAbstractSem n_jobs action = do + compile_sem <- newQSem n_jobs + n_capabilities <- getNumCapabilities + n_cpus <- getNumProcessors + let + asem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + set_num_caps n = unless (n_capabilities /= 1) $ setNumCapabilities n + updNumCapabilities = do + -- Setting number of capabilities more than + -- CPU count usually leads to high userspace + -- lock contention. #9221 + set_num_caps $ min n_jobs n_cpus + resetNumCapabilities = set_num_caps n_capabilities + MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem + +runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a +runWorkerLimit worker_limit action = case worker_limit of + NumProcessorsLimit n_jobs -> + runNjobsAbstractSem n_jobs action + JSemLimit sem -> + runJSemAbstractSem sem action -- | Build and run a pipeline -runParPipelines :: Int -- ^ How many capabilities to use - -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module +runParPipelines :: WorkerLimit -- ^ How to limit work parallelism + -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module -> Maybe Messager -- ^ Optional custom messager to use to report progress -> [MakeAction] -- ^ The build plan for all the module nodes -> IO () -runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do +runParPipelines worker_limit plugin_hsc_env mHscMessager all_pipelines = do -- A variable which we write to when an error has happened and we have to tell the @@ -2862,39 +2901,23 @@ runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do -- will add it's LogQueue into this queue. log_queue_queue_var <- newTVarIO newLogQueueQueue -- Thread which coordinates the printing of logs - wait_log_thread <- logThread n_jobs (length all_pipelines) (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var + wait_log_thread <- logThread (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var -- Make the logger thread-safe, in case there is some output which isn't sent via the LogQueue. thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env) let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger } - let updNumCapabilities = liftIO $ do - n_capabilities <- getNumCapabilities - n_cpus <- getNumProcessors - -- Setting number of capabilities more than - -- CPU count usually leads to high userspace - -- lock contention. #9221 - let n_caps = min n_jobs n_cpus - unless (n_capabilities /= 1) $ setNumCapabilities n_caps - return n_capabilities - - let resetNumCapabilities orig_n = do - liftIO $ setNumCapabilities orig_n - atomically $ writeTVar stopped_var True - wait_log_thread - - compile_sem <- newQSem n_jobs - let abstract_sem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + runWorkerLimit worker_limit $ \abstract_sem -> do + let env = MakeEnv { hsc_env = thread_safe_hsc_env + , withLogger = withParLog log_queue_queue_var + , compile_sem = abstract_sem + , env_messager = mHscMessager + } -- Reset the number of capabilities once the upsweep ends. - let env = MakeEnv { hsc_env = thread_safe_hsc_env - , withLogger = withParLog log_queue_queue_var - , compile_sem = abstract_sem - , env_messager = mHscMessager - } - - MC.bracket updNumCapabilities resetNumCapabilities $ \_ -> - runAllPipelines n_jobs env all_pipelines + runAllPipelines worker_limit env all_pipelines + atomically $ writeTVar stopped_var True + wait_log_thread withLocalTmpFS :: RunMakeM a -> RunMakeM a withLocalTmpFS act = do @@ -2911,10 +2934,11 @@ withLocalTmpFS act = do MC.bracket initialiser finaliser $ \lcl_hsc_env -> local (\env -> env { hsc_env = lcl_hsc_env}) act -- | Run the given actions and then wait for them all to finish. -runAllPipelines :: Int -> MakeEnv -> [MakeAction] -> IO () -runAllPipelines n_jobs env acts = do - let spawn_actions :: IO [ThreadId] - spawn_actions = if n_jobs == 1 +runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO () +runAllPipelines worker_limit env acts = do + let single_worker = isWorkerLimitSequential worker_limit + spawn_actions :: IO [ThreadId] + spawn_actions = if single_worker then (:[]) <$> (forkIOWithUnmask $ \unmask -> void $ runLoop (\io -> io unmask) env acts) else runLoop forkIOWithUnmask env acts ===================================== compiler/GHC/Driver/MakeSem.hs ===================================== @@ -0,0 +1,548 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE NumericUnderscores #-} + +-- | Implementation of a jobserver using system semaphores. +-- +-- +module GHC.Driver.MakeSem + ( -- * JSem: parallelism semaphore backed + -- by a system semaphore (Posix/Windows) + runJSemAbstractSem + + -- * System semaphores + , Semaphore, SemaphoreName(..) + + -- * Abstract semaphores + , AbstractSem(..) + , withAbstractSem + ) + where + +import GHC.Prelude +import GHC.Conc +import GHC.Data.OrdList +import GHC.IO.Exception +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Json + +import System.Semaphore + +import Control.Monad +import qualified Control.Monad.Catch as MC +import Control.Concurrent.MVar +import Control.Concurrent.STM +import Data.Foldable +import Data.Functor +import GHC.Stack +import Debug.Trace + +--------------------------------------- +-- Semaphore jobserver + +-- | A jobserver based off a system 'Semaphore'. +-- +-- Keeps track of the pending jobs and resources +-- available from the semaphore. +data Jobserver + = Jobserver + { jSemaphore :: !Semaphore + -- ^ The semaphore which controls available resources + , jobs :: !(TVar JobResources) + -- ^ The currently pending jobs, and the resources + -- obtained from the semaphore + } + +data JobserverOptions + = JobserverOptions + { releaseDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between acquiring a token + -- and releasing a token. + , setNumCapsDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between two consecutive + -- calls of 'setNumCapabilities'. + } + +defaultJobserverOptions :: JobserverOptions +defaultJobserverOptions = + JobserverOptions + { releaseDebounce = 1000 -- 1 second + , setNumCapsDebounce = 1000 -- 1 second + } + +-- | Resources available for running jobs, i.e. +-- tokens obtained from the parallelism semaphore. +data JobResources + = Jobs + { tokensOwned :: !Int + -- ^ How many tokens have been claimed from the semaphore + , tokensFree :: !Int + -- ^ How many tokens are not currently being used + , jobsWaiting :: !(OrdList (TMVar ())) + -- ^ Pending jobs waiting on a token, the job will be blocked on the TMVar so putting into + -- the TMVar will allow the job to continue. + } + +instance Outputable JobResources where + ppr Jobs{..} + = text "JobResources" <+> + ( braces $ hsep + [ text "owned=" <> ppr tokensOwned + , text "free=" <> ppr tokensFree + , text "num_waiting=" <> ppr (length jobsWaiting) + ] ) + +-- | Add one new token. +addToken :: JobResources -> JobResources +addToken jobs@( Jobs { tokensOwned = owned, tokensFree = free }) + = jobs { tokensOwned = owned + 1, tokensFree = free + 1 } + +-- | Free one token. +addFreeToken :: JobResources -> JobResources +addFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (tokensOwned jobs > free) + (text "addFreeToken:" <+> ppr (tokensOwned jobs) <+> ppr free) + $ jobs { tokensFree = free + 1 } + +-- | Use up one token. +removeFreeToken :: JobResources -> JobResources +removeFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (free > 0) + (text "removeFreeToken:" <+> ppr free) + $ jobs { tokensFree = free - 1 } + +-- | Return one owned token. +removeOwnedToken :: JobResources -> JobResources +removeOwnedToken jobs@( Jobs { tokensOwned = owned }) + = assertPpr (owned > 1) + (text "removeOwnedToken:" <+> ppr owned) + $ jobs { tokensOwned = owned - 1 } + +-- | Add one new job to the end of the list of pending jobs. +addJob :: TMVar () -> JobResources -> JobResources +addJob job jobs@( Jobs { jobsWaiting = wait }) + = jobs { jobsWaiting = wait `SnocOL` job } + +-- | The state of the semaphore job server. +data JobserverState + = JobserverState + { jobserverAction :: !JobserverAction + -- ^ The current action being performed by the + -- job server. + , canChangeNumCaps :: !(TVar Bool) + -- ^ A TVar that signals whether it has been long + -- enough since we last changed 'numCapabilities'. + , canReleaseToken :: !(TVar Bool) + -- ^ A TVar that signals whether we last acquired + -- a token long enough ago that we can now release + -- a token. + } +data JobserverAction + -- | The jobserver is idle: no thread is currently + -- interacting with the semaphore. + = Idle + -- | A thread is waiting for a token on the semaphore. + | Acquiring + { activeWaitId :: WaitId + , threadFinished :: TMVar (Maybe MC.SomeException) } + +-- | Retrieve the 'TMVar' that signals if the current thread has finished, +-- if any thread is currently active in the jobserver. +activeThread_maybe :: JobserverAction -> Maybe (TMVar (Maybe MC.SomeException)) +activeThread_maybe Idle = Nothing +activeThread_maybe (Acquiring { threadFinished = tmvar }) = Just tmvar + +-- | Whether we should try to acquire a new token from the semaphore: +-- there is a pending job and no free tokens. +guardAcquire :: JobResources -> Bool +guardAcquire ( Jobs { tokensFree, jobsWaiting } ) + = tokensFree == 0 && not (null jobsWaiting) + +-- | Whether we should release a token from the semaphore: +-- there are no pending jobs and we can release a token. +guardRelease :: JobResources -> Bool +guardRelease ( Jobs { tokensFree, tokensOwned, jobsWaiting } ) + = null jobsWaiting && tokensFree > 0 && tokensOwned > 1 + +--------------------------------------- +-- Semaphore jobserver implementation + +-- | Add one pending job to the jobserver. +-- +-- Blocks, waiting on the jobserver to supply a free token. +acquireJob :: TVar JobResources -> IO () +acquireJob jobs_tvar = do + (job_tmvar, _jobs0) <- tracedAtomically "acquire" $ + modifyJobResources jobs_tvar \ jobs -> do + job_tmvar <- newEmptyTMVar + return ((job_tmvar, jobs), addJob job_tmvar jobs) + atomically $ takeTMVar job_tmvar + +-- | Signal to the job server that one job has completed, +-- releasing its corresponding token. +releaseJob :: TVar JobResources -> IO () +releaseJob jobs_tvar = do + tracedAtomically "release" do + modifyJobResources jobs_tvar \ jobs -> do + massertPpr (tokensFree jobs < tokensOwned jobs) + (text "releaseJob: more free jobs than owned jobs!") + return ((), addFreeToken jobs) + + +-- | Release all tokens owned from the semaphore (to clean up +-- the jobserver at the end). +cleanupJobserver :: Jobserver -> IO () +cleanupJobserver (Jobserver { jSemaphore = sem + , jobs = jobs_tvar }) + = do + Jobs { tokensOwned = owned } <- readTVarIO jobs_tvar + let toks_to_release = owned - 1 + -- Subtract off the implicit token: whoever spawned the ghc process + -- in the first place is responsible for that token. + releaseSemaphore sem toks_to_release + +-- | Dispatch the available tokens acquired from the semaphore +-- to the pending jobs in the job server. +dispatchTokens :: JobResources -> STM JobResources +dispatchTokens jobs@( Jobs { tokensFree = toks_free, jobsWaiting = wait } ) + | toks_free > 0 + , next `ConsOL` rest <- wait + -- There's a pending job and a free token: + -- pass on the token to that job, and recur. + = do + putTMVar next () + let jobs' = jobs { tokensFree = toks_free - 1, jobsWaiting = rest } + dispatchTokens jobs' + | otherwise + = return jobs + +-- | Update the available resources used from a semaphore, dispatching +-- any newly acquired resources. +-- +-- Invariant: if the number of available resources decreases, there +-- must be no pending jobs. +-- +-- All modifications should go through this function to ensure the contents +-- of the 'TVar' remains in normal form. +modifyJobResources :: HasCallStack => TVar JobResources + -> (JobResources -> STM (a, JobResources)) + -> STM (a, Maybe JobResources) +modifyJobResources jobs_tvar action = do + old_jobs <- readTVar jobs_tvar + (a, jobs) <- action old_jobs + + -- Check the invariant: if the number of free tokens has decreased, + -- there must be no pending jobs. + massertPpr (null (jobsWaiting jobs) || tokensFree jobs >= tokensFree old_jobs) $ + vcat [ text "modiyJobResources: pending jobs but fewer free tokens" ] + dispatched_jobs <- dispatchTokens jobs + writeTVar jobs_tvar dispatched_jobs + return (a, Just dispatched_jobs) + + +tracedAtomically_ :: String -> STM (Maybe JobResources) -> IO () +tracedAtomically_ s act = tracedAtomically s (((),) <$> act) + +tracedAtomically :: String -> STM (a, Maybe JobResources) -> IO a +tracedAtomically origin act = do + (a, mjr) <- atomically act + forM_ mjr $ \ jr -> do + -- Use the "jsem:" prefix to identify where the write traces are + traceEventIO ("jsem:" ++ renderJobResources origin jr) + return a + +renderJobResources :: String -> JobResources -> String +renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON $ + JSObject [ ("name", JSString origin) + , ("owned", JSInt own) + , ("free", JSInt free) + , ("pending", JSInt (length pending) ) + ] + + +-- | Spawn a new thread that waits on the semaphore in order to acquire +-- an additional token. +acquireThread :: Jobserver -> IO JobserverAction +acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + let + wait_result_action :: Either MC.SomeException Bool -> IO () + wait_result_action wait_res = + tracedAtomically_ "acquire_thread" do + (r, jb) <- case wait_res of + Left (e :: MC.SomeException) -> do + return $ (Just e, Nothing) + Right success -> do + if success + then do + modifyJobResources jobs_tvar \ jobs -> + return (Nothing, addToken jobs) + else + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jb + wait_id <- forkWaitOnSemaphoreInterruptible sem wait_result_action + labelThread (waitingThreadId wait_id) "acquire_thread" + return $ Acquiring { activeWaitId = wait_id + , threadFinished = threadFinished_tmvar } + +-- | Spawn a thread to release ownership of one resource from the semaphore, +-- provided we have spare resources and no pending jobs. +releaseThread :: Jobserver -> IO JobserverAction +releaseThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + MC.mask_ do + -- Pre-release the resource so that another thread doesn't take control of it + -- just as we release the lock on the semaphore. + still_ok_to_release + <- tracedAtomically "pre_release" $ + modifyJobResources jobs_tvar \ jobs -> + if guardRelease jobs + -- TODO: should this also debounce? + then return (True , removeOwnedToken $ removeFreeToken jobs) + else return (False, jobs) + if not still_ok_to_release + then return Idle + else do + tid <- forkIO $ do + x <- MC.try $ releaseSemaphore sem 1 + tracedAtomically_ "post-release" $ do + (r, jobs) <- case x of + Left (e :: MC.SomeException) -> do + modifyJobResources jobs_tvar \ jobs -> + return (Just e, addToken jobs) + Right _ -> do + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jobs + labelThread tid "release_thread" + return Idle + +-- | When there are pending jobs but no free tokens, +-- spawn a thread to acquire a new token from the semaphore. +-- +-- See 'acquireThread'. +tryAcquire :: JobserverOptions + -> Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryAcquire opts js@( Jobserver { jobs = jobs_tvar }) + st@( JobserverState { jobserverAction = Idle } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardAcquire jobs + return do + action <- acquireThread js + -- Set a debounce after acquiring a token. + can_release_tvar <- registerDelay $ (releaseDebounce opts * 1000) + return $ st { jobserverAction = action + , canReleaseToken = can_release_tvar } +tryAcquire _ _ _ = retry + +-- | When there are free tokens and no pending jobs, +-- spawn a thread to release a token from the semamphore. +-- +-- See 'releaseThread'. +tryRelease :: Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryRelease sjs@( Jobserver { jobs = jobs_tvar } ) + st@( JobserverState + { jobserverAction = Idle + , canReleaseToken = can_release_tvar } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardRelease jobs + can_release <- readTVar can_release_tvar + guard can_release + return do + action <- releaseThread sjs + return $ st { jobserverAction = action } +tryRelease _ _ = retry + +-- | Wait for an active thread to finish. Once it finishes: +-- +-- - set the 'JobserverAction' to 'Idle', +-- - update the number of capabilities to reflect the number +-- of owned tokens from the semaphore. +tryNoticeIdle :: JobserverOptions + -> TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryNoticeIdle opts jobs_tvar jobserver_state + | Just threadFinished_tmvar <- activeThread_maybe $ jobserverAction jobserver_state + = sync_num_caps (canChangeNumCaps jobserver_state) threadFinished_tmvar + | otherwise + = retry -- no active thread: wait until jobserver isn't idle + where + sync_num_caps :: TVar Bool + -> TMVar (Maybe MC.SomeException) + -> STM (IO JobserverState) + sync_num_caps can_change_numcaps_tvar threadFinished_tmvar = do + mb_ex <- takeTMVar threadFinished_tmvar + for_ mb_ex MC.throwM + Jobs { tokensOwned } <- readTVar jobs_tvar + can_change_numcaps <- readTVar can_change_numcaps_tvar + guard can_change_numcaps + return do + x <- getNumCapabilities + can_change_numcaps_tvar_2 <- + if x == tokensOwned + then return can_change_numcaps_tvar + else do + setNumCapabilities tokensOwned + registerDelay $ (setNumCapsDebounce opts * 1000) + return $ + jobserver_state + { jobserverAction = Idle + , canChangeNumCaps = can_change_numcaps_tvar_2 } + +-- | Try to stop the current thread which is acquiring/releasing resources +-- if that operation is no longer relevant. +tryStopThread :: TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryStopThread jobs_tvar jsj = do + case jobserverAction jsj of + Acquiring { activeWaitId = wait_id } -> do + jobs <- readTVar jobs_tvar + guard $ null (jobsWaiting jobs) + return do + interruptWaitOnSemaphore wait_id + return $ jsj { jobserverAction = Idle } + _ -> retry + +-- | Main jobserver loop: acquire/release resources as +-- needed for the pending jobs and available semaphore tokens. +jobserverLoop :: JobserverOptions -> Jobserver -> IO () +jobserverLoop opts sjs@(Jobserver { jobs = jobs_tvar }) + = do + true_tvar <- newTVarIO True + let init_state :: JobserverState + init_state = + JobserverState + { jobserverAction = Idle + , canChangeNumCaps = true_tvar + , canReleaseToken = true_tvar } + loop init_state + where + loop s = do + action <- atomically $ asum $ (\x -> x s) <$> + [ tryRelease sjs + , tryAcquire opts sjs + , tryNoticeIdle opts jobs_tvar + , tryStopThread jobs_tvar + ] + s <- action + loop s + +-- | Create a new jobserver using the given semaphore handle. +makeJobserver :: SemaphoreName -> IO (AbstractSem, IO ()) +makeJobserver sem_name = do + semaphore <- openSemaphore sem_name + let + init_jobs = + Jobs { tokensOwned = 1 + , tokensFree = 1 + , jobsWaiting = NilOL + } + jobs_tvar <- newTVarIO init_jobs + let + opts = defaultJobserverOptions -- TODO: allow this to be configured + sjs = Jobserver { jSemaphore = semaphore + , jobs = jobs_tvar } + loop_finished_mvar <- newEmptyMVar + loop_tid <- forkIOWithUnmask \ unmask -> do + r <- try $ unmask $ jobserverLoop opts sjs + putMVar loop_finished_mvar $ + case r of + Left e + | Just ThreadKilled <- fromException e + -> Nothing + | otherwise + -> Just e + Right () -> Nothing + labelThread loop_tid "job_server" + let + acquireSem = acquireJob jobs_tvar + releaseSem = releaseJob jobs_tvar + cleanupSem = do + -- this is interruptible + cleanupJobserver sjs + killThread loop_tid + mb_ex <- takeMVar loop_finished_mvar + for_ mb_ex MC.throwM + + return (AbstractSem{..}, cleanupSem) + +-- | Implement an abstract semaphore using a semaphore 'Jobserver' +-- which queries the system semaphore of the given name for resources. +runJSemAbstractSem :: SemaphoreName -- ^ the system semaphore to use + -> (AbstractSem -> IO a) -- ^ the operation to run + -- which requires a semaphore + -> IO a +runJSemAbstractSem sem action = MC.mask \ unmask -> do + (abs, cleanup) <- makeJobserver sem + r <- try $ unmask $ action abs + case r of + Left (e1 :: MC.SomeException) -> do + (_ :: Either MC.SomeException ()) <- MC.try cleanup + MC.throwM e1 + Right x -> cleanup $> x + +{- +Note [Architecture of the Job Server] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In `-jsem` mode, the amount of parallelism that GHC can use is controlled by a +system semaphore. We take resources from the semaphore when we need them, and +give them back if we don't have enough to do. + +A naive implementation would just take and release the semaphore around performing +the action, but this leads to two issues: + +* When taking a token in the semaphore, we must call `setNumCapabilities` in order + to adjust how many capabilities are available for parallel garbage collection. + This causes unnecessary synchronisations. +* We want to implement a debounce, so that whilst there is pending work in the + current process we prefer to keep hold of resources from the semaphore. + This reduces overall memory usage, as there are fewer live GHC processes at once. + +Therefore, the obtention of semaphore resources is separated away from the +request for the resource in the driver. + +A token from the semaphore is requested using `acquireJob`. This creates a pending +job, which is a MVar that can be filled in to signal that the requested token is ready. + +When the job is finished, the token is released by calling `releaseJob`, which just +increases the number of `free` jobs. If there are more pending jobs when the free count +is increased, the token is immediately reused (see `modifyJobResources`). + +The `jobServerLoop` interacts with the system semaphore: when there are pending +jobs, `acquireThread` blocks, waiting for a token from the semaphore. Once a +token is obtained, it increases the owned count. + +When GHC has free tokens (tokens from the semaphore that it is not using), +no pending jobs, and the debounce has expired, then `releaseThread` will +release tokens back to the global semaphore. + +`tryStopThread` attempts to kill threads which are waiting to acquire a resource +when we no longer need it. For example, consider that we attempt to acquire two +tokens, but the first job finishes before we acquire the second token. +This second token is no longer needed, so we should cancel the wait +(as it would not be used to do any work, and not be returned until the debounce). +We only need to kill `acquireJob`, because `releaseJob` never blocks. + +Note [Eventlog Messages for jsem] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +It can be tricky to verify that the work is shared adequately across different +processes. To help debug this, we output the values of `JobResource` to the +eventlog whenever the global state changes. There are some scripts which can be used +to analyse this output and report statistics about core saturation in the +GitHub repo (https://github.com/mpickering/ghc-jsem-analyse). + +-} ===================================== compiler/GHC/Driver/Pipeline/LogQueue.hs ===================================== @@ -100,10 +100,10 @@ dequeueLogQueueQueue (LogQueueQueue n lqq) = case IM.minViewWithKey lqq of Just ((k, v), lqq') | k == n -> Just (v, LogQueueQueue (n + 1) lqq') _ -> Nothing -logThread :: Int -> Int -> Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit +logThread :: Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit -> TVar LogQueueQueue -- Queue for logs -> IO (IO ()) -logThread _ _ logger stopped lqq_var = do +logThread logger stopped lqq_var = do finished_var <- newEmptyMVar _ <- forkIO $ print_logs *> putMVar finished_var () return (takeMVar finished_var) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -43,6 +43,7 @@ module GHC.Driver.Session ( needSourceNotes, OnOff(..), DynFlags(..), + ParMakeCount(..), outputFile, objectSuf, ways, FlagSpec(..), HasDynFlags(..), ContainsDynFlags(..), @@ -461,9 +462,9 @@ data DynFlags = DynFlags { ruleCheck :: Maybe String, strictnessBefore :: [Int], -- ^ Additional demand analysis - parMakeCount :: Maybe Int, -- ^ The number of modules to compile in parallel - -- in --make mode, where Nothing ==> compile as - -- many in parallel as there are CPUs. + parMakeCount :: Maybe ParMakeCount, + -- ^ The number of modules to compile in parallel + -- If unspecified, compile with a single job. enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? ghcHeapSize :: Maybe Int, -- ^ The heap size to set. @@ -783,6 +784,13 @@ instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where class ContainsDynFlags t where extractDynFlags :: t -> DynFlags +-- | The type for the -jN argument, specifying that -j on its own represents +-- using the number of machine processors. +data ParMakeCount + = ParMakeThisMany Int -- -j + | ParMakeSemaphore FilePath --jsem + | ParMakeNumProcessors -- -j + ----------------------------------------------------------------------------- -- Accessors from 'DynFlags' @@ -1146,7 +1154,7 @@ defaultDynFlags mySettings = historySize = 20, strictnessBefore = [], - parMakeCount = Just 1, + parMakeCount = Nothing, enableTimeStats = False, ghcHeapSize = Nothing, @@ -2066,14 +2074,16 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "j" (OptIntSuffix (\n -> case n of Just n - | n > 0 -> upd (\d -> d { parMakeCount = Just n }) + | n > 0 -> upd (\d -> d { parMakeCount = Just (ParMakeThisMany n) }) | otherwise -> addErr "Syntax: -j[n] where n > 0" - Nothing -> upd (\d -> d { parMakeCount = Nothing }))) + Nothing -> upd (\d -> d { parMakeCount = Just ParMakeNumProcessors }))) -- When the number of parallel builds -- is omitted, it is the same -- as specifying that the number of -- parallel builds is equal to the -- result of getNumProcessors + , make_ord_flag defGhcFlag "jsem" $ hasArg $ \f d -> d { parMakeCount = Just (ParMakeSemaphore f) } + , make_ord_flag defFlag "instantiated-with" (sepArg setUnitInstantiations) , make_ord_flag defFlag "this-component-id" (sepArg setUnitInstanceOf) ===================================== compiler/ghc.cabal.in ===================================== @@ -85,6 +85,7 @@ Library hpc == 0.6.*, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, + semaphore-compat, stm, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, @@ -436,6 +437,7 @@ Library GHC.Driver.GenerateCgIPEStub GHC.Driver.Hooks GHC.Driver.LlvmConfigCache + GHC.Driver.MakeSem GHC.Driver.Main GHC.Driver.Make GHC.Driver.MakeFile ===================================== docs/users_guide/using.rst ===================================== @@ -751,6 +751,59 @@ search path (see :ref:`search-path`). number of processors. Note that compilation of a module may not begin until its dependencies have been built. + +GHC Jobserver Protocol +~~~~~~~~~~~~~~~~~~~~~~ + +This protocol allows +a server to dynamically invoke many instances of a client process, +while restricting all of those instances to use no more than capabilities. +This is achieved by coordination over a system semaphore (either a POSIX +semaphore in the case of Linux and Darwin, or a Win32 semaphore +in the case of Windows platforms). + +There are two kinds of participants in the GHC Jobserver protocol: + +- The *jobserver* creates a system semaphore with a certain number of + available tokens. + + Each time the jobserver wants to spawn a new jobclient subprocess, it **must** + first acquire a single token from the semaphore, before spawning + the subprocess. This token **must** be released once the subprocess terminates. + + Once work is finished, the jobserver **must** destroy the semaphore it created. + +- A *jobclient* is a subprocess spawned by the jobserver or another jobclient. + + Each jobclient starts with one available token (its *implicit token*, + which was acquired by the parent which spawned it), and can request more + tokens through the Jobserver Protocol by waiting on the semaphore. + + Each time a jobclient wants to spawn a new jobclient subprocess, it **must** + pass on a single token to the child jobclient. This token can either be the + jobclient's implicit token, or another token which the jobclient acquired + from the semaphore. + + Each jobclient **must** release exactly as many tokens as it has acquired from + the semaphore (this does not include the implicit tokens). + + GHC itself acts as a jobclient which can be enabled by using the flag ``-jsem``. + +.. ghc-flag:: -jsem + :shortdesc: When compiling with :ghc-flag:`--make`, coordinate with + other processes through the semaphore ⟨sem⟩ to compile + modules in parallel. + :type: dynamic + :category: misc + + Perform compilation in parallel when possible, coordinating with other + processes through the semaphore ⟨sem⟩. + Error if the semaphore doesn't exist. + + Use of ``-jsem`` will override use of `-j[⟨n⟩]`:ghc-flag:. + + + .. _multi-home-units: Multiple Home Units ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -39,7 +39,7 @@ ghcPackages = , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl - , parsec, pretty, process, rts, runGhc, stm, templateHaskell + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon @@ -55,7 +55,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, - parsec, pretty, primitive, process, rts, runGhc, stm, templateHaskell, + parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -110,6 +110,7 @@ process = lib "process" remoteIserv = util "remote-iserv" rts = top "rts" runGhc = util "runghc" +semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" terminfo = lib "terminfo" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -171,6 +171,7 @@ toolTargets = [ binary , templateHaskell , text , transformers + , semaphoreCompat , unlit -- # executable ] ++ if windowsHost then [ win32 ] else [ unix ] ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -95,6 +95,7 @@ stage0Packages = do , hpcBin , mtl , parsec + , semaphoreCompat , time , templateHaskell , text @@ -142,6 +143,7 @@ stage1Packages = do , integerGmp , pretty , rts + , semaphoreCompat , stm , unlit , xhtml ===================================== libraries/semaphore-compat ===================================== @@ -0,0 +1 @@ +Subproject commit 663ef75467995acf41c51d3e21d03347e85b844e ===================================== packages ===================================== @@ -65,5 +65,6 @@ libraries/Win32 - - https:/ libraries/xhtml - - https://github.com/haskell/xhtml.git libraries/exceptions - - https://github.com/ekmett/exceptions.git nofib nofib - - +libraries/semaphore-compat - - - libraries/stm - - ssh://git at github.com/haskell/stm.git . - ghc.git - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1755da7f439bbedd9dd3bdfd3ef2366f50c8fea1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1755da7f439bbedd9dd3bdfd3ef2366f50c8fea1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 11:57:26 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 22 Mar 2023 07:57:26 -0400 Subject: [Git][ghc/ghc][wip/jsem] Implement -jsem: parallelism controlled by semaphores Message-ID: <641aed2662265_90da31105b7c5705bc@gitlab.mail> Matthew Pickering pushed to branch wip/jsem at Glasgow Haskell Compiler / GHC Commits: a9a3b8d1 by sheaf at 2023-03-22T11:56:52+00:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 13 changed files: - .gitmodules - cabal.project-reinstall - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/ghc.cabal.in - docs/users_guide/using.rst - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - + libraries/semaphore-compat - packages Changes: ===================================== .gitmodules ===================================== @@ -83,6 +83,10 @@ url = https://gitlab.haskell.org/ghc/packages/unix.git ignore = untracked branch = 2.7 +[submodule "libraries/semaphore-compat"] + path = libraries/semaphore-compat + url = https://gitlab.haskell.org/ghc/semaphore-compat.git + ignore = untracked [submodule "libraries/stm"] path = libraries/stm url = https://gitlab.haskell.org/ghc/packages/stm.git ===================================== cabal.project-reinstall ===================================== @@ -28,6 +28,7 @@ packages: ./compiler ./libraries/parsec/ -- ./libraries/pretty/ ./libraries/process/ + ./libraries/semaphore-compat ./libraries/stm -- ./libraries/template-haskell/ ./libraries/terminfo/ ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -75,6 +75,7 @@ import GHC.Driver.Env import GHC.Driver.Errors import GHC.Driver.Errors.Types import GHC.Driver.Main +import GHC.Driver.MakeSem import GHC.Parser.Header @@ -149,9 +150,9 @@ import GHC.Runtime.Loader import GHC.Rename.Names import GHC.Utils.Constants import GHC.Types.Unique.DFM (udfmRestrictKeysSet) -import qualified Data.IntSet as I import GHC.Types.Unique +import qualified Data.IntSet as I -- ----------------------------------------------------------------------------- -- Loading the program @@ -657,6 +658,30 @@ createBuildPlan mod_graph maybe_top_mod = (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (length (mgModSummaries' mod_graph )))]) build_plan +mkWorkerLimit :: DynFlags -> IO WorkerLimit +mkWorkerLimit dflags = + case parMakeCount dflags of + Nothing -> pure $ num_procs 1 + Just (ParMakeSemaphore h) -> pure (JSemLimit (SemaphoreName h)) + Just ParMakeNumProcessors -> num_procs <$> getNumProcessors + Just (ParMakeThisMany n) -> pure $ num_procs n + where + num_procs x = NumProcessorsLimit (max 1 x) + +isWorkerLimitSequential :: WorkerLimit -> Bool +isWorkerLimitSequential (NumProcessorsLimit x) = x <= 1 +isWorkerLimitSequential (JSemLimit {}) = False + +-- | This describes what we use to limit the number of jobs, either we limit it +-- ourselves to a specific number or we have an external parallelism semaphore +-- limit it for us. +data WorkerLimit + = NumProcessorsLimit Int + | JSemLimit + SemaphoreName + -- ^ Semaphore name to use + deriving Eq + -- | Generalized version of 'load' which also supports a custom -- 'Messager' (for reporting progress) and 'ModuleGraph' (generally -- produced by calling 'depanal'. @@ -737,14 +762,12 @@ load' mhmi_cache how_much mHscMessage mod_graph = do liftIO $ debugTraceMsg logger 2 (hang (text "Ready for upsweep") 2 (ppr build_plan)) - n_jobs <- case parMakeCount (hsc_dflags hsc_env) of - Nothing -> liftIO getNumProcessors - Just n -> return n + worker_limit <- liftIO $ mkWorkerLimit dflags setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do hsc_env <- getSession - liftIO $ upsweep n_jobs hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan + liftIO $ upsweep worker_limit hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan setSession hsc_env1 case upsweep_ok of Failed -> loadFinish upsweep_ok @@ -1029,13 +1052,7 @@ getDependencies direct_deps build_map = type BuildM a = StateT BuildLoopState IO a --- | Abstraction over the operations of a semaphore which allows usage with the --- -j1 case -data AbstractSem = AbstractSem { acquireSem :: IO () - , releaseSem :: IO () } -withAbstractSem :: AbstractSem -> IO b -> IO b -withAbstractSem sem = MC.bracket_ (acquireSem sem) (releaseSem sem) -- | Environment used when compiling a module data MakeEnv = MakeEnv { hsc_env :: !HscEnv -- The basic HscEnv which will be augmented for each module @@ -1220,7 +1237,7 @@ withCurrentUnit uid = do local (\env -> env { hsc_env = hscSetActiveUnitId uid (hsc_env env)}) upsweep - :: Int -- ^ The number of workers we wish to run in parallel + :: WorkerLimit -- ^ The number of workers we wish to run in parallel -> HscEnv -- ^ The base HscEnv, which is augmented for each module -> Maybe ModIfaceCache -- ^ A cache to incrementally write final interface files to -> Maybe Messager @@ -2825,7 +2842,7 @@ label_self thread_name = do CC.labelThread self_tid thread_name -runPipelines :: Int -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () +runPipelines :: WorkerLimit -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () -- Don't even initialise plugins if there are no pipelines runPipelines _ _ _ [] = return () runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do @@ -2833,7 +2850,7 @@ runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do plugins_hsc_env <- initializePlugins orig_hsc_env case n_job of - 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines + NumProcessorsLimit n | n <= 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines _n -> runParPipelines n_job plugins_hsc_env mHscMessager all_pipelines runSeqPipelines :: HscEnv -> Maybe Messager -> [MakeAction] -> IO () @@ -2843,16 +2860,38 @@ runSeqPipelines plugin_hsc_env mHscMessager all_pipelines = , compile_sem = AbstractSem (return ()) (return ()) , env_messager = mHscMessager } - in runAllPipelines 1 env all_pipelines + in runAllPipelines (NumProcessorsLimit 1) env all_pipelines +runNjobsAbstractSem :: Int -> (AbstractSem -> IO a) -> IO a +runNjobsAbstractSem n_jobs action = do + compile_sem <- newQSem n_jobs + n_capabilities <- getNumCapabilities + n_cpus <- getNumProcessors + let + asem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + set_num_caps n = unless (n_capabilities /= 1) $ setNumCapabilities n + updNumCapabilities = do + -- Setting number of capabilities more than + -- CPU count usually leads to high userspace + -- lock contention. #9221 + set_num_caps $ min n_jobs n_cpus + resetNumCapabilities = set_num_caps n_capabilities + MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem + +runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a +runWorkerLimit worker_limit action = case worker_limit of + NumProcessorsLimit n_jobs -> + runNjobsAbstractSem n_jobs action + JSemLimit sem -> + runJSemAbstractSem sem action -- | Build and run a pipeline -runParPipelines :: Int -- ^ How many capabilities to use - -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module +runParPipelines :: WorkerLimit -- ^ How to limit work parallelism + -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module -> Maybe Messager -- ^ Optional custom messager to use to report progress -> [MakeAction] -- ^ The build plan for all the module nodes -> IO () -runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do +runParPipelines worker_limit plugin_hsc_env mHscMessager all_pipelines = do -- A variable which we write to when an error has happened and we have to tell the @@ -2862,39 +2901,23 @@ runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do -- will add it's LogQueue into this queue. log_queue_queue_var <- newTVarIO newLogQueueQueue -- Thread which coordinates the printing of logs - wait_log_thread <- logThread n_jobs (length all_pipelines) (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var + wait_log_thread <- logThread (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var -- Make the logger thread-safe, in case there is some output which isn't sent via the LogQueue. thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env) let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger } - let updNumCapabilities = liftIO $ do - n_capabilities <- getNumCapabilities - n_cpus <- getNumProcessors - -- Setting number of capabilities more than - -- CPU count usually leads to high userspace - -- lock contention. #9221 - let n_caps = min n_jobs n_cpus - unless (n_capabilities /= 1) $ setNumCapabilities n_caps - return n_capabilities - - let resetNumCapabilities orig_n = do - liftIO $ setNumCapabilities orig_n - atomically $ writeTVar stopped_var True - wait_log_thread - - compile_sem <- newQSem n_jobs - let abstract_sem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + runWorkerLimit worker_limit $ \abstract_sem -> do + let env = MakeEnv { hsc_env = thread_safe_hsc_env + , withLogger = withParLog log_queue_queue_var + , compile_sem = abstract_sem + , env_messager = mHscMessager + } -- Reset the number of capabilities once the upsweep ends. - let env = MakeEnv { hsc_env = thread_safe_hsc_env - , withLogger = withParLog log_queue_queue_var - , compile_sem = abstract_sem - , env_messager = mHscMessager - } - - MC.bracket updNumCapabilities resetNumCapabilities $ \_ -> - runAllPipelines n_jobs env all_pipelines + runAllPipelines worker_limit env all_pipelines + atomically $ writeTVar stopped_var True + wait_log_thread withLocalTmpFS :: RunMakeM a -> RunMakeM a withLocalTmpFS act = do @@ -2911,10 +2934,11 @@ withLocalTmpFS act = do MC.bracket initialiser finaliser $ \lcl_hsc_env -> local (\env -> env { hsc_env = lcl_hsc_env}) act -- | Run the given actions and then wait for them all to finish. -runAllPipelines :: Int -> MakeEnv -> [MakeAction] -> IO () -runAllPipelines n_jobs env acts = do - let spawn_actions :: IO [ThreadId] - spawn_actions = if n_jobs == 1 +runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO () +runAllPipelines worker_limit env acts = do + let single_worker = isWorkerLimitSequential worker_limit + spawn_actions :: IO [ThreadId] + spawn_actions = if single_worker then (:[]) <$> (forkIOWithUnmask $ \unmask -> void $ runLoop (\io -> io unmask) env acts) else runLoop forkIOWithUnmask env acts ===================================== compiler/GHC/Driver/MakeSem.hs ===================================== @@ -0,0 +1,548 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE NumericUnderscores #-} + +-- | Implementation of a jobserver using system semaphores. +-- +-- +module GHC.Driver.MakeSem + ( -- * JSem: parallelism semaphore backed + -- by a system semaphore (Posix/Windows) + runJSemAbstractSem + + -- * System semaphores + , Semaphore, SemaphoreName(..) + + -- * Abstract semaphores + , AbstractSem(..) + , withAbstractSem + ) + where + +import GHC.Prelude +import GHC.Conc +import GHC.Data.OrdList +import GHC.IO.Exception +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Json + +import System.Semaphore + +import Control.Monad +import qualified Control.Monad.Catch as MC +import Control.Concurrent.MVar +import Control.Concurrent.STM +import Data.Foldable +import Data.Functor +import GHC.Stack +import Debug.Trace + +--------------------------------------- +-- Semaphore jobserver + +-- | A jobserver based off a system 'Semaphore'. +-- +-- Keeps track of the pending jobs and resources +-- available from the semaphore. +data Jobserver + = Jobserver + { jSemaphore :: !Semaphore + -- ^ The semaphore which controls available resources + , jobs :: !(TVar JobResources) + -- ^ The currently pending jobs, and the resources + -- obtained from the semaphore + } + +data JobserverOptions + = JobserverOptions + { releaseDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between acquiring a token + -- and releasing a token. + , setNumCapsDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between two consecutive + -- calls of 'setNumCapabilities'. + } + +defaultJobserverOptions :: JobserverOptions +defaultJobserverOptions = + JobserverOptions + { releaseDebounce = 1000 -- 1 second + , setNumCapsDebounce = 1000 -- 1 second + } + +-- | Resources available for running jobs, i.e. +-- tokens obtained from the parallelism semaphore. +data JobResources + = Jobs + { tokensOwned :: !Int + -- ^ How many tokens have been claimed from the semaphore + , tokensFree :: !Int + -- ^ How many tokens are not currently being used + , jobsWaiting :: !(OrdList (TMVar ())) + -- ^ Pending jobs waiting on a token, the job will be blocked on the TMVar so putting into + -- the TMVar will allow the job to continue. + } + +instance Outputable JobResources where + ppr Jobs{..} + = text "JobResources" <+> + ( braces $ hsep + [ text "owned=" <> ppr tokensOwned + , text "free=" <> ppr tokensFree + , text "num_waiting=" <> ppr (length jobsWaiting) + ] ) + +-- | Add one new token. +addToken :: JobResources -> JobResources +addToken jobs@( Jobs { tokensOwned = owned, tokensFree = free }) + = jobs { tokensOwned = owned + 1, tokensFree = free + 1 } + +-- | Free one token. +addFreeToken :: JobResources -> JobResources +addFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (tokensOwned jobs > free) + (text "addFreeToken:" <+> ppr (tokensOwned jobs) <+> ppr free) + $ jobs { tokensFree = free + 1 } + +-- | Use up one token. +removeFreeToken :: JobResources -> JobResources +removeFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (free > 0) + (text "removeFreeToken:" <+> ppr free) + $ jobs { tokensFree = free - 1 } + +-- | Return one owned token. +removeOwnedToken :: JobResources -> JobResources +removeOwnedToken jobs@( Jobs { tokensOwned = owned }) + = assertPpr (owned > 1) + (text "removeOwnedToken:" <+> ppr owned) + $ jobs { tokensOwned = owned - 1 } + +-- | Add one new job to the end of the list of pending jobs. +addJob :: TMVar () -> JobResources -> JobResources +addJob job jobs@( Jobs { jobsWaiting = wait }) + = jobs { jobsWaiting = wait `SnocOL` job } + +-- | The state of the semaphore job server. +data JobserverState + = JobserverState + { jobserverAction :: !JobserverAction + -- ^ The current action being performed by the + -- job server. + , canChangeNumCaps :: !(TVar Bool) + -- ^ A TVar that signals whether it has been long + -- enough since we last changed 'numCapabilities'. + , canReleaseToken :: !(TVar Bool) + -- ^ A TVar that signals whether we last acquired + -- a token long enough ago that we can now release + -- a token. + } +data JobserverAction + -- | The jobserver is idle: no thread is currently + -- interacting with the semaphore. + = Idle + -- | A thread is waiting for a token on the semaphore. + | Acquiring + { activeWaitId :: WaitId + , threadFinished :: TMVar (Maybe MC.SomeException) } + +-- | Retrieve the 'TMVar' that signals if the current thread has finished, +-- if any thread is currently active in the jobserver. +activeThread_maybe :: JobserverAction -> Maybe (TMVar (Maybe MC.SomeException)) +activeThread_maybe Idle = Nothing +activeThread_maybe (Acquiring { threadFinished = tmvar }) = Just tmvar + +-- | Whether we should try to acquire a new token from the semaphore: +-- there is a pending job and no free tokens. +guardAcquire :: JobResources -> Bool +guardAcquire ( Jobs { tokensFree, jobsWaiting } ) + = tokensFree == 0 && not (null jobsWaiting) + +-- | Whether we should release a token from the semaphore: +-- there are no pending jobs and we can release a token. +guardRelease :: JobResources -> Bool +guardRelease ( Jobs { tokensFree, tokensOwned, jobsWaiting } ) + = null jobsWaiting && tokensFree > 0 && tokensOwned > 1 + +--------------------------------------- +-- Semaphore jobserver implementation + +-- | Add one pending job to the jobserver. +-- +-- Blocks, waiting on the jobserver to supply a free token. +acquireJob :: TVar JobResources -> IO () +acquireJob jobs_tvar = do + (job_tmvar, _jobs0) <- tracedAtomically "acquire" $ + modifyJobResources jobs_tvar \ jobs -> do + job_tmvar <- newEmptyTMVar + return ((job_tmvar, jobs), addJob job_tmvar jobs) + atomically $ takeTMVar job_tmvar + +-- | Signal to the job server that one job has completed, +-- releasing its corresponding token. +releaseJob :: TVar JobResources -> IO () +releaseJob jobs_tvar = do + tracedAtomically "release" do + modifyJobResources jobs_tvar \ jobs -> do + massertPpr (tokensFree jobs < tokensOwned jobs) + (text "releaseJob: more free jobs than owned jobs!") + return ((), addFreeToken jobs) + + +-- | Release all tokens owned from the semaphore (to clean up +-- the jobserver at the end). +cleanupJobserver :: Jobserver -> IO () +cleanupJobserver (Jobserver { jSemaphore = sem + , jobs = jobs_tvar }) + = do + Jobs { tokensOwned = owned } <- readTVarIO jobs_tvar + let toks_to_release = owned - 1 + -- Subtract off the implicit token: whoever spawned the ghc process + -- in the first place is responsible for that token. + releaseSemaphore sem toks_to_release + +-- | Dispatch the available tokens acquired from the semaphore +-- to the pending jobs in the job server. +dispatchTokens :: JobResources -> STM JobResources +dispatchTokens jobs@( Jobs { tokensFree = toks_free, jobsWaiting = wait } ) + | toks_free > 0 + , next `ConsOL` rest <- wait + -- There's a pending job and a free token: + -- pass on the token to that job, and recur. + = do + putTMVar next () + let jobs' = jobs { tokensFree = toks_free - 1, jobsWaiting = rest } + dispatchTokens jobs' + | otherwise + = return jobs + +-- | Update the available resources used from a semaphore, dispatching +-- any newly acquired resources. +-- +-- Invariant: if the number of available resources decreases, there +-- must be no pending jobs. +-- +-- All modifications should go through this function to ensure the contents +-- of the 'TVar' remains in normal form. +modifyJobResources :: HasCallStack => TVar JobResources + -> (JobResources -> STM (a, JobResources)) + -> STM (a, Maybe JobResources) +modifyJobResources jobs_tvar action = do + old_jobs <- readTVar jobs_tvar + (a, jobs) <- action old_jobs + + -- Check the invariant: if the number of free tokens has decreased, + -- there must be no pending jobs. + massertPpr (null (jobsWaiting jobs) || tokensFree jobs >= tokensFree old_jobs) $ + vcat [ text "modiyJobResources: pending jobs but fewer free tokens" ] + dispatched_jobs <- dispatchTokens jobs + writeTVar jobs_tvar dispatched_jobs + return (a, Just dispatched_jobs) + + +tracedAtomically_ :: String -> STM (Maybe JobResources) -> IO () +tracedAtomically_ s act = tracedAtomically s (((),) <$> act) + +tracedAtomically :: String -> STM (a, Maybe JobResources) -> IO a +tracedAtomically origin act = do + (a, mjr) <- atomically act + forM_ mjr $ \ jr -> do + -- Use the "jsem:" prefix to identify where the write traces are + traceEventIO ("jsem:" ++ renderJobResources origin jr) + return a + +renderJobResources :: String -> JobResources -> String +renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON $ + JSObject [ ("name", JSString origin) + , ("owned", JSInt own) + , ("free", JSInt free) + , ("pending", JSInt (length pending) ) + ] + + +-- | Spawn a new thread that waits on the semaphore in order to acquire +-- an additional token. +acquireThread :: Jobserver -> IO JobserverAction +acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + let + wait_result_action :: Either MC.SomeException Bool -> IO () + wait_result_action wait_res = + tracedAtomically_ "acquire_thread" do + (r, jb) <- case wait_res of + Left (e :: MC.SomeException) -> do + return $ (Just e, Nothing) + Right success -> do + if success + then do + modifyJobResources jobs_tvar \ jobs -> + return (Nothing, addToken jobs) + else + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jb + wait_id <- forkWaitOnSemaphoreInterruptible sem wait_result_action + labelThread (waitingThreadId wait_id) "acquire_thread" + return $ Acquiring { activeWaitId = wait_id + , threadFinished = threadFinished_tmvar } + +-- | Spawn a thread to release ownership of one resource from the semaphore, +-- provided we have spare resources and no pending jobs. +releaseThread :: Jobserver -> IO JobserverAction +releaseThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + MC.mask_ do + -- Pre-release the resource so that another thread doesn't take control of it + -- just as we release the lock on the semaphore. + still_ok_to_release + <- tracedAtomically "pre_release" $ + modifyJobResources jobs_tvar \ jobs -> + if guardRelease jobs + -- TODO: should this also debounce? + then return (True , removeOwnedToken $ removeFreeToken jobs) + else return (False, jobs) + if not still_ok_to_release + then return Idle + else do + tid <- forkIO $ do + x <- MC.try $ releaseSemaphore sem 1 + tracedAtomically_ "post-release" $ do + (r, jobs) <- case x of + Left (e :: MC.SomeException) -> do + modifyJobResources jobs_tvar \ jobs -> + return (Just e, addToken jobs) + Right _ -> do + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jobs + labelThread tid "release_thread" + return Idle + +-- | When there are pending jobs but no free tokens, +-- spawn a thread to acquire a new token from the semaphore. +-- +-- See 'acquireThread'. +tryAcquire :: JobserverOptions + -> Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryAcquire opts js@( Jobserver { jobs = jobs_tvar }) + st@( JobserverState { jobserverAction = Idle } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardAcquire jobs + return do + action <- acquireThread js + -- Set a debounce after acquiring a token. + can_release_tvar <- registerDelay $ (releaseDebounce opts * 1000) + return $ st { jobserverAction = action + , canReleaseToken = can_release_tvar } +tryAcquire _ _ _ = retry + +-- | When there are free tokens and no pending jobs, +-- spawn a thread to release a token from the semamphore. +-- +-- See 'releaseThread'. +tryRelease :: Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryRelease sjs@( Jobserver { jobs = jobs_tvar } ) + st@( JobserverState + { jobserverAction = Idle + , canReleaseToken = can_release_tvar } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardRelease jobs + can_release <- readTVar can_release_tvar + guard can_release + return do + action <- releaseThread sjs + return $ st { jobserverAction = action } +tryRelease _ _ = retry + +-- | Wait for an active thread to finish. Once it finishes: +-- +-- - set the 'JobserverAction' to 'Idle', +-- - update the number of capabilities to reflect the number +-- of owned tokens from the semaphore. +tryNoticeIdle :: JobserverOptions + -> TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryNoticeIdle opts jobs_tvar jobserver_state + | Just threadFinished_tmvar <- activeThread_maybe $ jobserverAction jobserver_state + = sync_num_caps (canChangeNumCaps jobserver_state) threadFinished_tmvar + | otherwise + = retry -- no active thread: wait until jobserver isn't idle + where + sync_num_caps :: TVar Bool + -> TMVar (Maybe MC.SomeException) + -> STM (IO JobserverState) + sync_num_caps can_change_numcaps_tvar threadFinished_tmvar = do + mb_ex <- takeTMVar threadFinished_tmvar + for_ mb_ex MC.throwM + Jobs { tokensOwned } <- readTVar jobs_tvar + can_change_numcaps <- readTVar can_change_numcaps_tvar + guard can_change_numcaps + return do + x <- getNumCapabilities + can_change_numcaps_tvar_2 <- + if x == tokensOwned + then return can_change_numcaps_tvar + else do + setNumCapabilities tokensOwned + registerDelay $ (setNumCapsDebounce opts * 1000) + return $ + jobserver_state + { jobserverAction = Idle + , canChangeNumCaps = can_change_numcaps_tvar_2 } + +-- | Try to stop the current thread which is acquiring/releasing resources +-- if that operation is no longer relevant. +tryStopThread :: TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryStopThread jobs_tvar jsj = do + case jobserverAction jsj of + Acquiring { activeWaitId = wait_id } -> do + jobs <- readTVar jobs_tvar + guard $ null (jobsWaiting jobs) + return do + interruptWaitOnSemaphore wait_id + return $ jsj { jobserverAction = Idle } + _ -> retry + +-- | Main jobserver loop: acquire/release resources as +-- needed for the pending jobs and available semaphore tokens. +jobserverLoop :: JobserverOptions -> Jobserver -> IO () +jobserverLoop opts sjs@(Jobserver { jobs = jobs_tvar }) + = do + true_tvar <- newTVarIO True + let init_state :: JobserverState + init_state = + JobserverState + { jobserverAction = Idle + , canChangeNumCaps = true_tvar + , canReleaseToken = true_tvar } + loop init_state + where + loop s = do + action <- atomically $ asum $ (\x -> x s) <$> + [ tryRelease sjs + , tryAcquire opts sjs + , tryNoticeIdle opts jobs_tvar + , tryStopThread jobs_tvar + ] + s <- action + loop s + +-- | Create a new jobserver using the given semaphore handle. +makeJobserver :: SemaphoreName -> IO (AbstractSem, IO ()) +makeJobserver sem_name = do + semaphore <- openSemaphore sem_name + let + init_jobs = + Jobs { tokensOwned = 1 + , tokensFree = 1 + , jobsWaiting = NilOL + } + jobs_tvar <- newTVarIO init_jobs + let + opts = defaultJobserverOptions -- TODO: allow this to be configured + sjs = Jobserver { jSemaphore = semaphore + , jobs = jobs_tvar } + loop_finished_mvar <- newEmptyMVar + loop_tid <- forkIOWithUnmask \ unmask -> do + r <- try $ unmask $ jobserverLoop opts sjs + putMVar loop_finished_mvar $ + case r of + Left e + | Just ThreadKilled <- fromException e + -> Nothing + | otherwise + -> Just e + Right () -> Nothing + labelThread loop_tid "job_server" + let + acquireSem = acquireJob jobs_tvar + releaseSem = releaseJob jobs_tvar + cleanupSem = do + -- this is interruptible + cleanupJobserver sjs + killThread loop_tid + mb_ex <- takeMVar loop_finished_mvar + for_ mb_ex MC.throwM + + return (AbstractSem{..}, cleanupSem) + +-- | Implement an abstract semaphore using a semaphore 'Jobserver' +-- which queries the system semaphore of the given name for resources. +runJSemAbstractSem :: SemaphoreName -- ^ the system semaphore to use + -> (AbstractSem -> IO a) -- ^ the operation to run + -- which requires a semaphore + -> IO a +runJSemAbstractSem sem action = MC.mask \ unmask -> do + (abs, cleanup) <- makeJobserver sem + r <- try $ unmask $ action abs + case r of + Left (e1 :: MC.SomeException) -> do + (_ :: Either MC.SomeException ()) <- MC.try cleanup + MC.throwM e1 + Right x -> cleanup $> x + +{- +Note [Architecture of the Job Server] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In `-jsem` mode, the amount of parallelism that GHC can use is controlled by a +system semaphore. We take resources from the semaphore when we need them, and +give them back if we don't have enough to do. + +A naive implementation would just take and release the semaphore around performing +the action, but this leads to two issues: + +* When taking a token in the semaphore, we must call `setNumCapabilities` in order + to adjust how many capabilities are available for parallel garbage collection. + This causes unnecessary synchronisations. +* We want to implement a debounce, so that whilst there is pending work in the + current process we prefer to keep hold of resources from the semaphore. + This reduces overall memory usage, as there are fewer live GHC processes at once. + +Therefore, the obtention of semaphore resources is separated away from the +request for the resource in the driver. + +A token from the semaphore is requested using `acquireJob`. This creates a pending +job, which is a MVar that can be filled in to signal that the requested token is ready. + +When the job is finished, the token is released by calling `releaseJob`, which just +increases the number of `free` jobs. If there are more pending jobs when the free count +is increased, the token is immediately reused (see `modifyJobResources`). + +The `jobServerLoop` interacts with the system semaphore: when there are pending +jobs, `acquireThread` blocks, waiting for a token from the semaphore. Once a +token is obtained, it increases the owned count. + +When GHC has free tokens (tokens from the semaphore that it is not using), +no pending jobs, and the debounce has expired, then `releaseThread` will +release tokens back to the global semaphore. + +`tryStopThread` attempts to kill threads which are waiting to acquire a resource +when we no longer need it. For example, consider that we attempt to acquire two +tokens, but the first job finishes before we acquire the second token. +This second token is no longer needed, so we should cancel the wait +(as it would not be used to do any work, and not be returned until the debounce). +We only need to kill `acquireJob`, because `releaseJob` never blocks. + +Note [Eventlog Messages for jsem] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +It can be tricky to verify that the work is shared adequately across different +processes. To help debug this, we output the values of `JobResource` to the +eventlog whenever the global state changes. There are some scripts which can be used +to analyse this output and report statistics about core saturation in the +GitHub repo (https://github.com/mpickering/ghc-jsem-analyse). + +-} ===================================== compiler/GHC/Driver/Pipeline/LogQueue.hs ===================================== @@ -100,10 +100,10 @@ dequeueLogQueueQueue (LogQueueQueue n lqq) = case IM.minViewWithKey lqq of Just ((k, v), lqq') | k == n -> Just (v, LogQueueQueue (n + 1) lqq') _ -> Nothing -logThread :: Int -> Int -> Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit +logThread :: Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit -> TVar LogQueueQueue -- Queue for logs -> IO (IO ()) -logThread _ _ logger stopped lqq_var = do +logThread logger stopped lqq_var = do finished_var <- newEmptyMVar _ <- forkIO $ print_logs *> putMVar finished_var () return (takeMVar finished_var) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -43,6 +43,7 @@ module GHC.Driver.Session ( needSourceNotes, OnOff(..), DynFlags(..), + ParMakeCount(..), outputFile, objectSuf, ways, FlagSpec(..), HasDynFlags(..), ContainsDynFlags(..), @@ -461,9 +462,9 @@ data DynFlags = DynFlags { ruleCheck :: Maybe String, strictnessBefore :: [Int], -- ^ Additional demand analysis - parMakeCount :: Maybe Int, -- ^ The number of modules to compile in parallel - -- in --make mode, where Nothing ==> compile as - -- many in parallel as there are CPUs. + parMakeCount :: Maybe ParMakeCount, + -- ^ The number of modules to compile in parallel + -- If unspecified, compile with a single job. enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? ghcHeapSize :: Maybe Int, -- ^ The heap size to set. @@ -783,6 +784,13 @@ instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where class ContainsDynFlags t where extractDynFlags :: t -> DynFlags +-- | The type for the -jN argument, specifying that -j on its own represents +-- using the number of machine processors. +data ParMakeCount + = ParMakeThisMany Int -- -j + | ParMakeSemaphore FilePath --jsem + | ParMakeNumProcessors -- -j + ----------------------------------------------------------------------------- -- Accessors from 'DynFlags' @@ -1146,7 +1154,7 @@ defaultDynFlags mySettings = historySize = 20, strictnessBefore = [], - parMakeCount = Just 1, + parMakeCount = Nothing, enableTimeStats = False, ghcHeapSize = Nothing, @@ -2066,14 +2074,16 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "j" (OptIntSuffix (\n -> case n of Just n - | n > 0 -> upd (\d -> d { parMakeCount = Just n }) + | n > 0 -> upd (\d -> d { parMakeCount = Just (ParMakeThisMany n) }) | otherwise -> addErr "Syntax: -j[n] where n > 0" - Nothing -> upd (\d -> d { parMakeCount = Nothing }))) + Nothing -> upd (\d -> d { parMakeCount = Just ParMakeNumProcessors }))) -- When the number of parallel builds -- is omitted, it is the same -- as specifying that the number of -- parallel builds is equal to the -- result of getNumProcessors + , make_ord_flag defGhcFlag "jsem" $ hasArg $ \f d -> d { parMakeCount = Just (ParMakeSemaphore f) } + , make_ord_flag defFlag "instantiated-with" (sepArg setUnitInstantiations) , make_ord_flag defFlag "this-component-id" (sepArg setUnitInstanceOf) ===================================== compiler/ghc.cabal.in ===================================== @@ -85,6 +85,7 @@ Library hpc == 0.6.*, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, + semaphore-compat, stm, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, @@ -436,6 +437,7 @@ Library GHC.Driver.GenerateCgIPEStub GHC.Driver.Hooks GHC.Driver.LlvmConfigCache + GHC.Driver.MakeSem GHC.Driver.Main GHC.Driver.Make GHC.Driver.MakeFile ===================================== docs/users_guide/using.rst ===================================== @@ -751,6 +751,59 @@ search path (see :ref:`search-path`). number of processors. Note that compilation of a module may not begin until its dependencies have been built. + +GHC Jobserver Protocol +~~~~~~~~~~~~~~~~~~~~~~ + +This protocol allows +a server to dynamically invoke many instances of a client process, +while restricting all of those instances to use no more than capabilities. +This is achieved by coordination over a system semaphore (either a POSIX +semaphore in the case of Linux and Darwin, or a Win32 semaphore +in the case of Windows platforms). + +There are two kinds of participants in the GHC Jobserver protocol: + +- The *jobserver* creates a system semaphore with a certain number of + available tokens. + + Each time the jobserver wants to spawn a new jobclient subprocess, it **must** + first acquire a single token from the semaphore, before spawning + the subprocess. This token **must** be released once the subprocess terminates. + + Once work is finished, the jobserver **must** destroy the semaphore it created. + +- A *jobclient* is a subprocess spawned by the jobserver or another jobclient. + + Each jobclient starts with one available token (its *implicit token*, + which was acquired by the parent which spawned it), and can request more + tokens through the Jobserver Protocol by waiting on the semaphore. + + Each time a jobclient wants to spawn a new jobclient subprocess, it **must** + pass on a single token to the child jobclient. This token can either be the + jobclient's implicit token, or another token which the jobclient acquired + from the semaphore. + + Each jobclient **must** release exactly as many tokens as it has acquired from + the semaphore (this does not include the implicit tokens). + + GHC itself acts as a jobclient which can be enabled by using the flag ``-jsem``. + +.. ghc-flag:: -jsem + :shortdesc: When compiling with :ghc-flag:`--make`, coordinate with + other processes through the semaphore ⟨sem⟩ to compile + modules in parallel. + :type: dynamic + :category: misc + + Perform compilation in parallel when possible, coordinating with other + processes through the semaphore ⟨sem⟩. + Error if the semaphore doesn't exist. + + Use of ``-jsem`` will override use of `-j[⟨n⟩]`:ghc-flag:. + + + .. _multi-home-units: Multiple Home Units ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -39,7 +39,7 @@ ghcPackages = , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl - , parsec, pretty, process, rts, runGhc, stm, templateHaskell + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon @@ -55,7 +55,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, - parsec, pretty, primitive, process, rts, runGhc, stm, templateHaskell, + parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -110,6 +110,7 @@ process = lib "process" remoteIserv = util "remote-iserv" rts = top "rts" runGhc = util "runghc" +semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" terminfo = lib "terminfo" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -171,6 +171,7 @@ toolTargets = [ binary , templateHaskell , text , transformers + , semaphoreCompat , unlit -- # executable ] ++ if windowsHost then [ win32 ] else [ unix ] ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -95,6 +95,7 @@ stage0Packages = do , hpcBin , mtl , parsec + , semaphoreCompat , time , templateHaskell , text @@ -142,6 +143,7 @@ stage1Packages = do , integerGmp , pretty , rts + , semaphoreCompat , stm , unlit , xhtml ===================================== libraries/semaphore-compat ===================================== @@ -0,0 +1 @@ +Subproject commit 663ef75467995acf41c51d3e21d03347e85b844e ===================================== packages ===================================== @@ -65,5 +65,6 @@ libraries/Win32 - - https:/ libraries/xhtml - - https://github.com/haskell/xhtml.git libraries/exceptions - - https://github.com/ekmett/exceptions.git nofib nofib - - +libraries/semaphore-compat - - - libraries/stm - - ssh://git at github.com/haskell/stm.git . - ghc.git - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9a3b8d13c70b83d527376162b25026a5a19859a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9a3b8d13c70b83d527376162b25026a5a19859a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 12:39:33 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 22 Mar 2023 08:39:33 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Be more careful about quantification Message-ID: <641af70580010_90da31e85f7c587126@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - 7dde4754 by Sylvain Henry at 2023-03-22T08:39:30-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 5 changed files: - compiler/GHC/Data/Bag.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9c7550f7b786de1b9f9dc0281d7d4733ece5f0e...7dde4754542b2c98d1aae3f58678347409221987 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9c7550f7b786de1b9f9dc0281d7d4733ece5f0e...7dde4754542b2c98d1aae3f58678347409221987 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 12:48:07 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 22 Mar 2023 08:48:07 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] 26 commits: Be more careful about quantification Message-ID: <641af907ebad1_90da31e95eb8592429@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - b2d35320 by Simon Peyton Jones at 2023-03-22T12:05:56+00:00 DRAFT: Refactor the way we establish a canonical constraint Relevant to #22194 Incomplete; but I'd like to see the CI results - - - - - 3c1e1f9f by Simon Peyton Jones at 2023-03-22T12:05:56+00:00 Wibbles - - - - - c1417307 by Simon Peyton Jones at 2023-03-22T12:05:56+00:00 Wibbles - - - - - a5234095 by Simon Peyton Jones at 2023-03-22T12:05:56+00:00 Wibbles - - - - - be59f757 by Simon Peyton Jones at 2023-03-22T12:05:56+00:00 Use a flag-based approach for checkTyEqRhs ...looks much nicer - - - - - 6efc7553 by Simon Peyton Jones at 2023-03-22T12:05:56+00:00 Wibble - - - - - a0e44e0c by Simon Peyton Jones at 2023-03-22T12:05:56+00:00 Bug fixes - - - - - 7a501ffa by Simon Peyton Jones at 2023-03-22T12:05:56+00:00 More bug fixes - - - - - 1b8ab979 by Simon Peyton Jones at 2023-03-22T12:05:56+00:00 Minor fixes - - - - - fbf8fd06 by Simon Peyton Jones at 2023-03-22T12:05:57+00:00 Fix isConcreteTyCon Adds a synIsConcrete to SynonymTyCon - - - - - 4ca5493b by Simon Peyton Jones at 2023-03-22T12:07:45+00:00 More wibbles - - - - - c910adcf by Simon Peyton Jones at 2023-03-22T12:07:45+00:00 Add a fast path simpleUnifyCheck - - - - - 2610291b by Simon Peyton Jones at 2023-03-22T12:07:45+00:00 Wibble - - - - - 4137ec61 by Simon Peyton Jones at 2023-03-22T12:07:45+00:00 Respond to Richard's review - - - - - 013348d3 by Simon Peyton Jones at 2023-03-22T12:07:45+00:00 More wibbles, prompted by talking with Richard - - - - - b3ceb28c by Simon Peyton Jones at 2023-03-22T12:07:45+00:00 More wibbles - - - - - 4b96e1cb by Simon Peyton Jones at 2023-03-22T12:07:45+00:00 Wibbles - - - - - 9b2d3ace by Simon Peyton Jones at 2023-03-22T12:07:45+00:00 Wibble - - - - - 1b0abad3 by Simon Peyton Jones at 2023-03-22T12:07:45+00:00 Wibbles - - - - - d5ffcc70 by Simon Peyton Jones at 2023-03-22T12:49:31+00:00 wibbles - - - - - 12 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd132a9b37ce1b7c35bffe7a161415db3cde4ccb...d5ffcc702d5c9be56c0abe27df64d8f3ddcca419 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd132a9b37ce1b7c35bffe7a161415db3cde4ccb...d5ffcc702d5c9be56c0abe27df64d8f3ddcca419 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 13:18:14 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 22 Mar 2023 09:18:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22696 Message-ID: <641b00163fdd_90da3299527860192d@gitlab.mail> Ryan Scott pushed new branch wip/T22696 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22696 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 15:45:57 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 22 Mar 2023 11:45:57 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Wibbles Message-ID: <641b22b5c72d6_90da352a63746244e7@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 554c9a5d by Simon Peyton Jones at 2023-03-22T15:47:14+00:00 Wibbles - - - - - 7 changed files: - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/partial-sigs/should_compile/T10403.stderr - testsuite/tests/polykinds/T9017.stderr - testsuite/tests/rep-poly/T13929.stderr - testsuite/tests/typecheck/should_fail/T16512a.stderr Changes: ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -179,7 +179,7 @@ import GHC.Data.Bag as Bag import GHC.Data.Pair import GHC.Utils.Monad -import GHC.Utils.Misc( equalLength ) +import GHC.Utils.Misc( equalLength, lengthIs ) import GHC.Exts (oneShot) import Control.Monad @@ -2091,8 +2091,13 @@ checkTouchableTyVarEq ev lhs_tv rhs | Just (tc,tys) <- splitTyConApp_maybe rhs , isTypeFamilyTyCon tc , not (isConcreteTyVar lhs_tv) - = do { tys_res <- mapCheck (checkTyEqRhs arg_flags) tys - ; return (mkTyConAppRedn Nominal tc <$> tys_res) } + , let arity = tyConArity tc + = if tys `lengthIs` arity + then recurseIntoTyConApp arg_flags tc tys + else do { let (fun_args, extra_args) = splitAt (tyConArity tc) tys + ; fun_res <- recurseIntoTyConApp arg_flags tc fun_args + ; extra_res <- mapCheck (checkTyEqRhs flags) extra_args + ; return (mkAppRedns <$> fun_res <*> extra_res) } | otherwise = checkTyEqRhs flags rhs ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -590,23 +590,31 @@ instance Semigroup CheckTyEqResult where instance Monoid CheckTyEqResult where mempty = cteOK +instance Eq CheckTyEqProblem where + (CTEP b1) == (CTEP b2) = b1==b2 + +instance Outputable CheckTyEqProblem where + ppr prob@(CTEP bits) = case lookup prob allBits of + Just s -> text s + Nothing -> text "unknown:" <+> ppr bits + instance Outputable CheckTyEqResult where ppr cter | cterHasNoProblem cter = text "cteOK" | otherwise - = braces $ fcat $ intersperse vbar $ set_bits - where - all_bits = [ (cteImpredicative, "cteImpredicative") - , (cteTypeFamily, "cteTypeFamily") - , (cteInsolubleOccurs, "cteInsolubleOccurs") - , (cteSolubleOccurs, "cteSolubleOccurs") - , (cteConcrete, "cteConcrete") - , (cteSkolemEscape, "cteSkolemEscape") - , (cteCoercionHole, "cteCoercionHole") - ] - set_bits = [ text str - | (bitmask, str) <- all_bits - , cter `cterHasProblem` bitmask ] + = braces $ fcat $ intersperse vbar $ + [ text str + | (bitmask, str) <- allBits + , cter `cterHasProblem` bitmask ] + +allBits :: [(CheckTyEqProblem, String)] +allBits = [ (cteImpredicative, "cteImpredicative") + , (cteTypeFamily, "cteTypeFamily") + , (cteInsolubleOccurs, "cteInsolubleOccurs") + , (cteSolubleOccurs, "cteSolubleOccurs") + , (cteConcrete, "cteConcrete") + , (cteSkolemEscape, "cteSkolemEscape") + , (cteCoercionHole, "cteCoercionHole") ] {- Note [CIrredCan constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecordWildCards #-} {- (c) The University of Glasgow 2006 @@ -33,10 +34,10 @@ module GHC.Tc.Utils.Unify ( matchExpectedFunKind, matchActualFunTySigma, matchActualFunTysRho, - checkTyEqRhs, + checkTyEqRhs, recurseIntoTyConApp, PuResult(..), failCheckWith, okCheckRefl, mapCheck, TyEqFlags(..), TyEqFamApp(..), AreUnifying(..), LevelCheck(..), FamAppBreaker, - famAppArgFlags, occursCheckTv, simpleUnifyCheck, checkPromoteFreeVars + famAppArgFlags, occursCheckTv, simpleUnifyCheck, checkPromoteFreeVars, ) where import GHC.Prelude @@ -2745,6 +2746,11 @@ instance (Outputable a, Outputable b) => Outputable (PuResult a b) where (vcat [ text "redn:" <+> ppr x , text "cts:" <+> ppr cts ]) +pprPur :: PuResult a b -> SDoc +-- For debugging +pprPur (PuFail prob) = text "PuFail:" <> ppr prob + +pprPur (PuOK {}) = text "PuOK" okCheckRefl :: TcType -> TcM (PuResult a Reduction) okCheckRefl ty = return (PuOK (mkReflRedn Nominal ty) emptyBag) @@ -2797,6 +2803,29 @@ data LevelCheck | LC_Promote -- Do a level check against this level; if it fails on a -- unification variable, promote it +instance Outputable (TyEqFlags a) where + ppr (TEF { .. }) = text "TEF" <> braces ( + vcat [ text "tef_foralls =" <+> ppr tef_foralls + , text "tef_lhs =" <+> ppr tef_lhs + , text "tef_unifying =" <+> ppr tef_unifying + , text "tef_fam_app =" <+> ppr tef_fam_app + , text "tef_occurs =" <+> ppr tef_occurs ]) + +instance Outputable (TyEqFamApp a) where + ppr TEFA_Fail = text "TEFA_Fail" + ppr TEFA_Recurse = text "TEFA_Fail" + ppr (TEFA_Break {}) = text "TEFA_Brefak" + +instance Outputable AreUnifying where + ppr NotUnifying = text "NotUnifying" + ppr (Unifying mi lvl lc) = text "Unifying" <+> + braces (ppr mi <> comma <+> ppr lvl <> comma <+> ppr lc) + +instance Outputable LevelCheck where + ppr LC_None = text "LC_None" + ppr LC_Check = text "LC_Check" + ppr LC_Promote = text "LC_Promote" + famAppArgFlags :: TyEqFlags a -> TyEqFlags a -- Adjust the flags when going undter a type family -- Only the outer family application gets the loop-breaker treatment @@ -2956,6 +2985,7 @@ checkTyConApp flags@(TEF { tef_unifying = unifying, tef_foralls = foralls_ok }) fun_app = mkTyConApp tc fun_args ; fun_res <- checkFamApp flags fun_app tc fun_args ; extra_res <- mapCheck (checkTyEqRhs flags) extra_args + ; traceTc "Over-sat" (ppr tc <+> ppr tys $$ ppr arity $$ pprPur fun_res $$ pprPur extra_res) ; return (mkAppRedns <$> fun_res <*> extra_res) } | not (isFamFreeTyCon tc) || isForgetfulSynTyCon tc @@ -2974,6 +3004,10 @@ checkTyConApp flags@(TEF { tef_unifying = unifying, tef_foralls = foralls_ok }) = failCheckWith (cteProblem cteConcrete) | otherwise -- Recurse on arguments + = recurseIntoTyConApp flags tc tys + +recurseIntoTyConApp :: TyEqFlags a -> TyCon -> [TcType] -> TcM (PuResult a Reduction) +recurseIntoTyConApp flags tc tys = do { tys_res <- mapCheck (checkTyEqRhs flags) tys ; return (mkTyConAppRedn Nominal tc <$> tys_res) } @@ -2990,7 +3024,7 @@ checkFamApp flags@(TEF { tef_unifying = unifying, tef_occurs = occ_prob | otherwise = case fam_app_flag of - TEFA_Fail -> failCheckWith (cteProblem cteTypeFamily) + TEFA_Fail -> failCheckWith (cteProblem cteTypeFamily) TEFA_Recurse | TyFamLHS lhs_tc lhs_tys <- lhs @@ -2999,6 +3033,7 @@ checkFamApp flags@(TEF { tef_unifying = unifying, tef_occurs = occ_prob | otherwise -> do { tys_res <- mapCheck (checkTyEqRhs arg_flags) tys + ; traceTc "under" (ppr tc $$ pprPur tys_res $$ ppr flags) ; return (mkTyConAppRedn Nominal tc <$> tys_res) } TEFA_Break breaker ===================================== testsuite/tests/partial-sigs/should_compile/T10403.stderr ===================================== @@ -15,22 +15,39 @@ T10403.hs:16:12: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)] T10403.hs:20:7: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ - standing for ‘(a1 -> a2) -> B t0 a1 -> H (B t0)’ - Where: ‘t0’ is an ambiguous type variable + standing for ‘(a1 -> a2) -> f0 a1 -> H f0’ + Where: ‘f0’ is an ambiguous type variable ‘a2’, ‘a1’ are rigid type variables bound by - the inferred type of h2 :: (a1 -> a2) -> B t0 a1 -> H (B t0) + the inferred type of h2 :: (a1 -> a2) -> f0 a1 -> H f0 at T10403.hs:23:1-41 • In the type signature: h2 :: _ +T10403.hs:23:15: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] + • Ambiguous type variable ‘f0’ arising from a use of ‘fmap’ + prevents the constraint ‘(Functor f0)’ from being solved. + Relevant bindings include + b :: f0 a1 (bound at T10403.hs:23:6) + h2 :: (a1 -> a2) -> f0 a1 -> H f0 (bound at T10403.hs:23:1) + Probable fix: use a type annotation to specify what ‘f0’ should be. + Potentially matching instances: + instance Functor IO -- Defined in ‘GHC.Base’ + instance Functor (B t) -- Defined at T10403.hs:11:10 + ...plus 8 others + ...plus one instance involving out-of-scope types + (use -fprint-potential-instances to see them all) + • In the second argument of ‘(.)’, namely ‘fmap (const ())’ + In the expression: (H . fmap (const ())) (fmap f b) + In an equation for ‘h2’: h2 f b = (H . fmap (const ())) (fmap f b) + T10403.hs:29:8: warning: [GHC-46956] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘t0’ with ‘t’ + • Couldn't match type ‘f0’ with ‘B t’ Expected: H (B t) - Actual: H (B t0) - because type variable ‘t’ would escape its scope - This (rigid, skolem) type variable is bound by - the type signature for: - app2 :: forall t. H (B t) - at T10403.hs:28:1-15 + Actual: H f0 + • because type variable ‘t’ would escape its scope + This (rigid, skolem) type variable is bound by + the type signature for: + app2 :: forall t. H (B t) + at T10403.hs:28:1-15 • In the expression: h2 (H . I) (B ()) In an equation for ‘app2’: app2 = h2 (H . I) (B ()) • Relevant bindings include ===================================== testsuite/tests/polykinds/T9017.stderr ===================================== @@ -1,12 +1,12 @@ T9017.hs:8:7: error: [GHC-25897] - • Couldn't match kind ‘k1’ with ‘*’ + • Couldn't match kind ‘k2’ with ‘*’ When matching types a0 :: * -> * -> * a :: k1 -> k2 -> * Expected: a b (m b) Actual: a0 b0 (m0 b0) - ‘k1’ is a rigid type variable bound by + ‘k2’ is a rigid type variable bound by the type signature for: foo :: forall {k1} {k2} (a :: k1 -> k2 -> *) (b :: k1) (m :: k1 -> k2). ===================================== testsuite/tests/rep-poly/T13929.stderr ===================================== @@ -3,8 +3,8 @@ T13929.hs:29:24: error: [GHC-55287] • The tuple argument in first position does not have a fixed runtime representation. Its type is: - GUnboxed f LiftedRep :: TYPE c0 - Cannot unify ‘rf’ with the type variable ‘c0’ + a0 :: TYPE k00 + Cannot unify ‘rf’ with the type variable ‘k00’ because it is not a concrete ‘RuntimeRep’. • In the expression: (# gunbox x, gunbox y #) In an equation for ‘gunbox’: @@ -12,7 +12,6 @@ T13929.hs:29:24: error: [GHC-55287] In the instance declaration for ‘GUnbox (f :*: g) (TupleRep [rf, rg])’ • Relevant bindings include - x :: f p (bound at T13929.hs:29:13) gunbox :: (:*:) f g p -> GUnboxed (f :*: g) (TupleRep [rf, rg]) (bound at T13929.hs:29:5) ===================================== testsuite/tests/typecheck/should_fail/T16512a.stderr ===================================== @@ -1,18 +1,20 @@ T16512a.hs:41:25: error: [GHC-25897] - • Couldn't match type ‘b’ with ‘a -> b’ + • Couldn't match type ‘as’ with ‘a : as’ Expected: AST (ListVariadic (a : as) b) Actual: AST (ListVariadic as (a -> b)) - ‘b’ is a rigid type variable bound by - the type signature for: - unapply :: forall b. AST b -> AnApplication b - at T16512a.hs:37:1-35 + ‘as’ is a rigid type variable bound by + a pattern with constructor: + AnApplication :: forall (as :: [*]) b. + AST (ListVariadic as b) -> ASTs as -> AnApplication b, + in a case alternative + at T16512a.hs:40:9-26 • In the first argument of ‘AnApplication’, namely ‘g’ In the expression: AnApplication g (a `ConsAST` as) In a case alternative: AnApplication g as -> AnApplication g (a `ConsAST` as) • Relevant bindings include + as :: ASTs as (bound at T16512a.hs:40:25) g :: AST (ListVariadic as (a -> b)) (bound at T16512a.hs:40:23) a :: AST a (bound at T16512a.hs:38:15) f :: AST (a -> b) (bound at T16512a.hs:38:10) - unapply :: AST b -> AnApplication b (bound at T16512a.hs:38:1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/554c9a5df5374f3c9c4253c69e98e08dacf20870 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/554c9a5df5374f3c9c4253c69e98e08dacf20870 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 16:10:33 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 22 Mar 2023 12:10:33 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Add structured error messages for GHC.Tc.Utils.TcMType Message-ID: <641b287997848_90da35a95cec6367f5@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 726e2617 by Torsten Schmits at 2023-03-22T12:10:20-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 42a97335 by Sylvain Henry at 2023-03-22T12:10:23-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 27 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/dependent/should_fail/T11334b.stderr - testsuite/tests/dependent/should_fail/T14880-2.stderr - testsuite/tests/dependent/should_fail/T14880.stderr - testsuite/tests/dependent/should_fail/T15076.stderr - testsuite/tests/dependent/should_fail/T15076b.stderr - testsuite/tests/dependent/should_fail/T15825.stderr - testsuite/tests/patsyn/should_fail/T14552.stderr - testsuite/tests/patsyn/should_fail/T21479.stderr - testsuite/tests/polykinds/T15795.stderr - testsuite/tests/polykinds/T15795a.stderr - testsuite/tests/rts/linker/all.T - testsuite/tests/typecheck/no_skolem_info/T14040A.stderr - testsuite/tests/typecheck/should_fail/T14350.stderr - testsuite/tests/typecheck/should_fail/T15474.stderr - testsuite/tests/typecheck/should_fail/T15807.stderr - testsuite/tests/typecheck/should_fail/T16946.stderr - testsuite/tests/typecheck/should_fail/T17301.stderr - testsuite/tests/typecheck/should_fail/T17562.stderr - testsuite/tests/typecheck/should_fail/T17567.stderr - testsuite/tests/typecheck/should_fail/T17567StupidTheta.stderr Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -40,7 +40,7 @@ import GHC.Core.FamInstEnv ( FamInst(..), famInstAxiom, pprFamInst ) import GHC.Core.InstEnv import GHC.Core.TyCo.Rep (Type(..)) import GHC.Core.TyCo.Ppr (pprWithExplicitKindsWhen, - pprSourceTyCon, pprTyVars, pprWithTYPE) + pprSourceTyCon, pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType) import GHC.Core.PatSyn ( patSynName, pprPatSynType ) import GHC.Core.Predicate import GHC.Core.Type @@ -1453,6 +1453,34 @@ instance Diagnostic TcRnMessage where TcRnTyThingUsedWrong sort thing name -> mkSimpleDecorated $ pprTyThingUsedWrong sort thing name + TcRnCannotDefaultKindVar var knd -> + mkSimpleDecorated $ + (vcat [ text "Cannot default kind variable" <+> quotes (ppr var) + , text "of kind:" <+> ppr knd + , text "Perhaps enable PolyKinds or add a kind signature" ]) + TcRnUninferrableTyvar tidied_tvs context -> + mkSimpleDecorated $ + pprWithExplicitKindsWhen True $ + vcat [ text "Uninferrable type variable" + <> plural tidied_tvs + <+> pprWithCommas pprTyVar tidied_tvs + <+> text "in" + , pprUninferrableTyvarCtx context ] + TcRnSkolemEscape escapees tv orig_ty -> + mkSimpleDecorated $ + pprWithExplicitKindsWhen True $ + vcat [ sep [ text "Cannot generalise type; skolem" <> plural escapees + , quotes $ pprTyVars escapees + , text "would escape" <+> itsOrTheir escapees <+> text "scope" + ] + , sep [ text "if I tried to quantify" + , pprTyVar tv + , text "in this type:" + ] + , nest 2 (pprTidiedType orig_ty) + , text "(Indeed, I sometimes struggle even printing this correctly," + , text " due to its ill-scoped nature.)" + ] diagnosticReason = \case TcRnUnknownMessage m @@ -1931,6 +1959,12 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnTyThingUsedWrong{} -> ErrorWithoutFlag + TcRnCannotDefaultKindVar{} + -> ErrorWithoutFlag + TcRnUninferrableTyvar{} + -> ErrorWithoutFlag + TcRnSkolemEscape{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2427,6 +2461,12 @@ instance Diagnostic TcRnMessage where -> noHints TcRnTyThingUsedWrong{} -> noHints + TcRnCannotDefaultKindVar{} + -> noHints + TcRnUninferrableTyvar{} + -> noHints + TcRnSkolemEscape{} + -> noHints diagnosticCode = constructorCode @@ -4505,3 +4545,19 @@ pprStageCheckReason = \case text "instance for" <+> quotes (ppr t) StageCheckSplice t -> quotes (ppr t) + +pprUninferrableTyvarCtx :: UninferrableTyvarCtx -> SDoc +pprUninferrableTyvarCtx = \case + UninfTyCtx_ClassContext theta -> + sep [ text "the class context:", pprTheta theta ] + UninfTyCtx_DataContext theta -> + sep [ text "the datatype context:", pprTheta theta ] + UninfTyCtx_ProvidedContext theta -> + sep [ text "the provided context:" , pprTheta theta ] + UninfTyCtx_TyfamRhs rhs_ty -> + sep [ text "the type family equation right-hand side:" , ppr rhs_ty ] + UninfTyCtx_TysynRhs rhs_ty -> + sep [ text "the type synonym right-hand side:" , ppr rhs_ty ] + UninfTyCtx_Sig exp_kind full_hs_ty -> + hang (text "the kind" <+> ppr exp_kind) 2 + (text "of the type signature:" <+> ppr full_hs_ty) ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -94,6 +94,7 @@ module GHC.Tc.Errors.Types ( , HsigShapeMismatchReason(..) , WrongThingSort(..) , StageCheckReason(..) + , UninferrableTyvarCtx(..) ) where import GHC.Prelude @@ -3257,6 +3258,41 @@ data TcRnMessage where -> !Name -- ^ Name of the thing used wrongly. -> TcRnMessage + {-| TcRnCannotDefaultKindVar is an error that occurs when attempting to use + unconstrained kind variables whose type isn't @Type@, without -XPolyKinds. + + Test cases: + T11334b + -} + TcRnCannotDefaultKindVar + :: !TyVar -- ^ The unconstrained variable. + -> !Kind -- ^ Kind of the variable. + -> TcRnMessage + + {-| TcRnUninferrableTyvar is an error that occurs when metavariables + in a type could not be defaulted. + + Test cases: + T17301, T17562, T17567, T17567StupidTheta, T15474, T21479 + -} + TcRnUninferrableTyvar + :: ![TyCoVar] -- ^ The variables that could not be defaulted. + -> !UninferrableTyvarCtx -- ^ Description of the surrounding context. + -> TcRnMessage + + {-| TcRnSkolemEscape is an error that occurs when type variables from an + outer scope is used in a context where they should be locally scoped. + + Test cases: + T15076, T15076b, T14880-2, T15825, T14880, T15807, T16946, T14350, + T14040A, T15795, T15795a, T14552 + -} + TcRnSkolemEscape + :: ![TcTyVar] -- ^ The variables that would escape. + -> !TcTyVar -- ^ The variable that is being quantified. + -> !Type -- ^ The type in which they occur. + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -4538,3 +4574,11 @@ data WrongThingSort data StageCheckReason = StageCheckInstance !InstanceWhat !PredType | StageCheckSplice !Name + +data UninferrableTyvarCtx + = UninfTyCtx_ClassContext [TcType] + | UninfTyCtx_DataContext [TcType] + | UninfTyCtx_ProvidedContext [TcType] + | UninfTyCtx_TyfamRhs TcType + | UninfTyCtx_TysynRhs TcType + | UninfTyCtx_Sig TcType (LHsSigType GhcRn) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -473,7 +473,7 @@ tc_lhs_sig_type skol_info full_hs_ty@(L loc (HsSig { sig_bndrs = hs_outer_bndrs -- Default any unconstrained variables free in the kind -- See Note [Escaping kind in type signatures] ; exp_kind_dvs <- candidateQTyVarsOfType exp_kind - ; doNotQuantifyTyVars exp_kind_dvs (mk_doc exp_kind) + ; doNotQuantifyTyVars exp_kind_dvs (err_ctx exp_kind) ; traceTc "tc_lhs_sig_type" (ppr hs_outer_bndrs $$ ppr outer_bndrs) ; outer_bndrs <- scopedSortOuter outer_bndrs @@ -488,10 +488,9 @@ tc_lhs_sig_type skol_info full_hs_ty@(L loc (HsSig { sig_bndrs = hs_outer_bndrs ; return (implic, mkInfForAllTys kvs ty1) } where - mk_doc exp_kind tidy_env + err_ctx exp_kind tidy_env = do { (tidy_env2, exp_kind) <- zonkTidyTcType tidy_env exp_kind - ; return (tidy_env2, hang (text "The kind" <+> ppr exp_kind) - 2 (text "of type signature:" <+> ppr full_hs_ty)) } + ; return (tidy_env2, UninfTyCtx_Sig exp_kind full_hs_ty) } ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -35,7 +35,8 @@ import GHC.Driver.Config.HsToCore import GHC.Hs import GHC.Tc.Errors.Types ( TcRnMessage(..), FixedRuntimeRepProvenance(..) - , mkTcRnUnknownMessage, IllegalNewtypeReason (..) ) + , mkTcRnUnknownMessage, IllegalNewtypeReason (..) + , UninferrableTyvarCtx (..) ) import GHC.Tc.TyCl.Build import GHC.Tc.Solver( pushLevelAndSolveEqualities, pushLevelAndSolveEqualitiesX , reportUnsolvedEqualities ) @@ -2455,11 +2456,9 @@ tcClassDecl1 roles_info class_name hs_ctxt meths fundeps sigs ats at_defs -- class (forall a. a b ~ a c) => C b c -- The kind of `a` is unconstrained. ; dvs <- candidateQTyVarsOfTypes ctxt - ; let mk_doc tidy_env = do { (tidy_env2, ctxt) <- zonkTidyTcTypes tidy_env ctxt - ; return ( tidy_env2 - , sep [ text "the class context:" - , pprTheta ctxt ] ) } - ; doNotQuantifyTyVars dvs mk_doc + ; let err_ctx tidy_env = do { (tidy_env2, ctxt) <- zonkTidyTcTypes tidy_env ctxt + ; return (tidy_env2, UninfTyCtx_ClassContext ctxt) } + ; doNotQuantifyTyVars dvs err_ctx -- The pushLevelAndSolveEqualities will report errors for any -- unsolved equalities, so these zonks should not encounter @@ -2873,11 +2872,9 @@ tcTySynRhs roles_info tc_name hs_ty -- type T = forall a. Proxy a -- The kind of `a` is unconstrained. ; dvs <- candidateQTyVarsOfType rhs_ty - ; let mk_doc tidy_env = do { (tidy_env2, rhs_ty) <- zonkTidyTcType tidy_env rhs_ty - ; return ( tidy_env2 - , sep [ text "the type synonym right-hand side:" - , ppr rhs_ty ] ) } - ; doNotQuantifyTyVars dvs mk_doc + ; let err_ctx tidy_env = do { (tidy_env2, rhs_ty) <- zonkTidyTcType tidy_env rhs_ty + ; return (tidy_env2, UninfTyCtx_TysynRhs rhs_ty) } + ; doNotQuantifyTyVars dvs err_ctx ; ze <- mkEmptyZonkEnv NoFlexi ; (ze, bndrs) <- zonkTyVarBindersX ze tc_bndrs @@ -2918,12 +2915,10 @@ tcDataDefn err_ctxt roles_info tc_name -- data (forall a. a b ~ a c) => T b c -- The kind of 'a' is unconstrained. ; dvs <- candidateQTyVarsOfTypes stupid_tc_theta - ; let mk_doc tidy_env + ; let err_ctx tidy_env = do { (tidy_env2, theta) <- zonkTidyTcTypes tidy_env stupid_tc_theta - ; return ( tidy_env2 - , sep [ text "the datatype context:" - , pprTheta theta ] ) } - ; doNotQuantifyTyVars dvs mk_doc + ; return (tidy_env2, UninfTyCtx_DataContext theta) } + ; doNotQuantifyTyVars dvs err_ctx -- Check that we don't use kind signatures without the extension ; kind_signatures <- xoptM LangExt.KindSignatures @@ -3178,12 +3173,10 @@ tcTyFamInstEqnGuts fam_tc mb_clsinfo outer_hs_bndrs hs_pats hs_rhs_ty -- See Note [Error on unconstrained meta-variables] in GHC.Tc.Utils.TcMType -- Example: typecheck/should_fail/T17301 ; dvs_rhs <- candidateQTyVarsOfType rhs_ty - ; let mk_doc tidy_env + ; let err_ctx tidy_env = do { (tidy_env2, rhs_ty) <- zonkTidyTcType tidy_env rhs_ty - ; return ( tidy_env2 - , sep [ text "type family equation right-hand side:" - , ppr rhs_ty ] ) } - ; doNotQuantifyTyVars dvs_rhs mk_doc + ; return (tidy_env2, UninfTyCtx_TyfamRhs rhs_ty) } + ; doNotQuantifyTyVars dvs_rhs err_ctx ; ze <- mkEmptyZonkEnv NoFlexi ; (ze, final_tvs) <- zonkTyBndrsX ze final_tvs ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -194,12 +194,10 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details -- Report un-quantifiable type variables: -- see Note [Unquantified tyvars in a pattern synonym] ; dvs <- candidateQTyVarsOfTypes prov_theta - ; let mk_doc tidy_env + ; let err_ctx tidy_env = do { (tidy_env2, theta) <- zonkTidyTcTypes tidy_env prov_theta - ; return ( tidy_env2 - , sep [ text "the provided context:" - , pprTheta theta ] ) } - ; doNotQuantifyTyVars dvs mk_doc + ; return ( tidy_env2, UninfTyCtx_ProvidedContext theta ) } + ; doNotQuantifyTyVars dvs err_ctx ; traceTc "tcInferPatSynDecl }" $ (ppr name $$ ppr ex_tvs) ; rec_fields <- lookupConstructorFields name ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -131,7 +131,6 @@ import GHC.Types.Name import GHC.Types.Var.Set import GHC.Builtin.Types -import GHC.Types.Error import GHC.Types.Var.Env import GHC.Types.Unique.Set import GHC.Types.Basic ( TypeOrKind(..) @@ -1853,10 +1852,7 @@ defaultTyVar def_strat tv ; writeMetaTyVar kv liftedTypeKind ; return True } | otherwise - = do { addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - (vcat [ text "Cannot default kind variable" <+> quotes (ppr kv') - , text "of kind:" <+> ppr (tyVarKind kv') - , text "Perhaps enable PolyKinds or add a kind signature" ]) + = do { addErr $ TcRnCannotDefaultKindVar kv' (tyVarKind kv') -- We failed to default it, so return False to say so. -- Hence, it'll get skolemised. That might seem odd, but we must either -- promote, skolemise, or zap-to-Any, to satisfy GHC.Tc.Gen.HsType @@ -2053,7 +2049,7 @@ C. Examine the class declaration at the top of this Note again. -} doNotQuantifyTyVars :: CandidatesQTvs - -> (TidyEnv -> TcM (TidyEnv, SDoc)) + -> (TidyEnv -> TcM (TidyEnv, UninferrableTyvarCtx)) -- ^ like "the class context (D a b, E foogle)" -> TcM () -- See Note [Error on unconstrained meta-variables] @@ -2072,14 +2068,7 @@ doNotQuantifyTyVars dvs where_found ; unless (null leftover_metas) $ do { let (tidy_env1, tidied_tvs) = tidyOpenTyCoVars emptyTidyEnv leftover_metas ; (tidy_env2, where_doc) <- where_found tidy_env1 - ; let msg = mkTcRnUnknownMessage $ - mkPlainError noHints $ - pprWithExplicitKindsWhen True $ - vcat [ text "Uninferrable type variable" - <> plural tidied_tvs - <+> pprWithCommas pprTyVar tidied_tvs - <+> text "in" - , where_doc ] + ; let msg = TcRnUninferrableTyvar tidied_tvs where_doc ; failWithTcM (tidy_env2, msg) } ; traceTc "doNotQuantifyTyVars success" empty } @@ -2741,21 +2730,8 @@ naughtyQuantification orig_ty tv escapees -- variables; very confusing to users! orig_ty' = tidyType env orig_ty1 - ppr_tidied = pprTyVars . map (tidyTyCoVarOcc env) - msg = mkTcRnUnknownMessage $ mkPlainError noHints $ - pprWithExplicitKindsWhen True $ - vcat [ sep [ text "Cannot generalise type; skolem" <> plural escapees' - , quotes $ ppr_tidied escapees' - , text "would escape" <+> itsOrTheir escapees' <+> text "scope" - ] - , sep [ text "if I tried to quantify" - , ppr_tidied [tv] - , text "in this type:" - ] - , nest 2 (pprTidiedType orig_ty') - , text "(Indeed, I sometimes struggle even printing this correctly," - , text " due to its ill-scoped nature.)" - ] + tidied = map (tidyTyCoVarOcc env) escapees' + msg = TcRnSkolemEscape tidied (tidyTyCoVarOcc env tv) orig_ty' ; failWithTcM (env, msg) } ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -539,6 +539,9 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnBadlyStaged" = 28914 GhcDiagnosticCode "TcRnStageRestriction" = 18157 GhcDiagnosticCode "TcRnTyThingUsedWrong" = 10969 + GhcDiagnosticCode "TcRnCannotDefaultKindVar" = 79924 + GhcDiagnosticCode "TcRnUninferrableTyvar" = 16220 + GhcDiagnosticCode "TcRnSkolemEscape" = 71451 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 ===================================== testsuite/tests/dependent/should_fail/T11334b.stderr ===================================== @@ -1,5 +1,5 @@ -T11334b.hs:8:14: error: +T11334b.hs:8:14: error: [GHC-79924] • Cannot default kind variable ‘a0’ of kind: k10 Perhaps enable PolyKinds or add a kind signature @@ -7,7 +7,7 @@ T11334b.hs:8:14: error: In the expression: Proxy :: Proxy 'Compose In an equation for ‘p’: p = Proxy :: Proxy 'Compose -T11334b.hs:8:14: error: +T11334b.hs:8:14: error: [GHC-79924] • Cannot default kind variable ‘g0’ of kind: k10 -> k0 Perhaps enable PolyKinds or add a kind signature @@ -15,7 +15,7 @@ T11334b.hs:8:14: error: In the expression: Proxy :: Proxy 'Compose In an equation for ‘p’: p = Proxy :: Proxy 'Compose -T11334b.hs:8:14: error: +T11334b.hs:8:14: error: [GHC-79924] • Cannot default kind variable ‘f0’ of kind: k0 -> * Perhaps enable PolyKinds or add a kind signature ===================================== testsuite/tests/dependent/should_fail/T14880-2.stderr ===================================== @@ -1,5 +1,5 @@ -T14880-2.hs:13:9: error: +T14880-2.hs:13:9: error: [GHC-71451] • Cannot generalise type; skolem ‘arg’ would escape its scope if I tried to quantify (a0 :: arg) in this type: forall arg. Proxy @{Proxy @{arg} a0 -> *} (Foo arg @a0) -> () ===================================== testsuite/tests/dependent/should_fail/T14880.stderr ===================================== @@ -1,5 +1,5 @@ -T14880.hs:13:5: error: +T14880.hs:13:5: error: [GHC-71451] • Cannot generalise type; skolem ‘arg’ would escape its scope if I tried to quantify (a0 :: arg) in this type: forall x arg. ===================================== testsuite/tests/dependent/should_fail/T15076.stderr ===================================== @@ -1,5 +1,5 @@ -T15076.hs:11:8: error: +T15076.hs:11:8: error: [GHC-71451] • Cannot generalise type; skolem ‘a’ would escape its scope if I tried to quantify (x0 :: a) in this type: forall a (f :: forall (x :: a). Proxy @{a} x -> *). ===================================== testsuite/tests/dependent/should_fail/T15076b.stderr ===================================== @@ -1,4 +1,4 @@ -T15076b.hs:9:8: error: +T15076b.hs:9:8: error: [GHC-71451] • Cannot generalise type; skolem ‘a’ would escape its scope if I tried to quantify (x0 :: a) in this type: forall a (f :: forall (x :: a). Proxy @{a} x -> *). ===================================== testsuite/tests/dependent/should_fail/T15825.stderr ===================================== @@ -1,5 +1,5 @@ -T15825.hs:14:10: error: +T15825.hs:14:10: error: [GHC-71451] • Cannot generalise type; skolem ‘k’ would escape its scope if I tried to quantify (x0 :: k) in this type: forall k (a :: C k). X (a @x0) ===================================== testsuite/tests/patsyn/should_fail/T14552.stderr ===================================== @@ -1,5 +1,5 @@ -T14552.hs:22:1: error: +T14552.hs:22:1: error: [GHC-71451] • Cannot generalise type; skolem ‘k’ would escape its scope if I tried to quantify (t0 :: k) in this type: forall k (w :: k --> *). Exp a0 (F @k @(*) w t0) ===================================== testsuite/tests/patsyn/should_fail/T21479.stderr ===================================== @@ -1,5 +1,5 @@ -T21479.hs:13:1: error: +T21479.hs:13:1: error: [GHC-16220] • Uninferrable type variable a0 in the provided context: (a0 :: *) ~ (Int :: *) • In the declaration for pattern synonym ‘T1’ ===================================== testsuite/tests/polykinds/T15795.stderr ===================================== @@ -1,5 +1,5 @@ -T15795.hs:12:3: error: +T15795.hs:12:3: error: [GHC-71451] • Cannot generalise type; skolem ‘k’ would escape its scope if I tried to quantify (a0 :: k) in this type: forall k (b :: k). T @k @a0 b ===================================== testsuite/tests/polykinds/T15795a.stderr ===================================== @@ -1,5 +1,5 @@ -T15795a.hs:9:3: error: +T15795a.hs:9:3: error: [GHC-71451] • Cannot generalise type; skolem ‘u’ would escape its scope if I tried to quantify (cat10 :: u) in this type: forall u (a :: u). F @u @cat10 a ===================================== testsuite/tests/rts/linker/all.T ===================================== @@ -28,7 +28,9 @@ test('T23066', # Test to see if linker scripts link properly to real ELF files test('T2615', [extra_files(['libfoo_T2615.c', 'libfoo_script_T2615.so']), - js_broken(22374), + # JavaScript linker doesn't support linker scripts + js_skip, + # Windows linker doesn't seem to support linker scripts when(opsys('mingw32'), skip), # OS X doesn't seem to support linker scripts when(opsys('darwin'), skip), ===================================== testsuite/tests/typecheck/no_skolem_info/T14040A.stderr ===================================== @@ -1,5 +1,5 @@ -T14040A.hs:13:8: error: +T14040A.hs:13:8: error: [GHC-71451] • Cannot generalise type; skolem ‘a’ would escape its scope if I tried to quantify (x0 :: a) in this type: forall a (f :: forall (x :: a). Proxy @{a} x -> *). ===================================== testsuite/tests/typecheck/should_fail/T14350.stderr ===================================== @@ -1,5 +1,5 @@ -T14350.hs:49:10: error: +T14350.hs:49:10: error: [GHC-71451] • Cannot generalise type; skolem ‘a’ would escape its scope if I tried to quantify (x0 :: a) in this type: forall a (b1 :: a ~> *) ===================================== testsuite/tests/typecheck/should_fail/T15474.stderr ===================================== @@ -1,5 +1,5 @@ -T15474.hs:10:1: error: +T15474.hs:10:1: error: [GHC-16220] • Uninferrable type variable k0 in the type synonym right-hand side: forall (t :: k0). Proxy @{k0} t • In the type declaration for ‘Forall’ ===================================== testsuite/tests/typecheck/should_fail/T15807.stderr ===================================== @@ -1,5 +1,5 @@ -T15807.hs:12:3: error: +T15807.hs:12:3: error: [GHC-71451] • Cannot generalise type; skolem ‘f’ would escape its scope if I tried to quantify (f0 :: f -> *) in this type: forall f (a :: f). f a %1 -> App @f @f0 a ===================================== testsuite/tests/typecheck/should_fail/T16946.stderr ===================================== @@ -1,5 +1,5 @@ -T16946.hs:11:9: error: +T16946.hs:11:9: error: [GHC-71451] • Cannot generalise type; skolem ‘k’ would escape its scope if I tried to quantify (y0 :: k) in this type: forall k (c :: k -> k -> *) ===================================== testsuite/tests/typecheck/should_fail/T17301.stderr ===================================== @@ -1,5 +1,6 @@ -T17301.hs:22:3: error: +T17301.hs:22:3: error: [GHC-16220] • Uninferrable type variable (a0 :: A) in - type family equation right-hand side: MkATySing @(B a0) (SB @a0) + the type family equation right-hand side: + MkATySing @(B a0) (SB @a0) • In the type family declaration for ‘Forget’ ===================================== testsuite/tests/typecheck/should_fail/T17562.stderr ===================================== @@ -1,5 +1,5 @@ -T17562.hs:7:1: error: +T17562.hs:7:1: error: [GHC-16220] • Uninferrable type variable k0 in the class context: forall (a :: k -> k0). (a b :: k0) ~ (a c :: k0) • In the class declaration for ‘C’ ===================================== testsuite/tests/typecheck/should_fail/T17567.stderr ===================================== @@ -1,5 +1,5 @@ -T17567.hs:7:1: error: +T17567.hs:7:1: error: [GHC-16220] • Uninferrable type variable k0 in the type synonym right-hand side: forall (a :: k0). Proxy @{k0} a • In the type declaration for ‘T’ ===================================== testsuite/tests/typecheck/should_fail/T17567StupidTheta.stderr ===================================== @@ -2,7 +2,7 @@ T17567StupidTheta.hs:1:37: warning: [-Wdeprecated-flags (in -Wdefault)] -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. -T17567StupidTheta.hs:6:1: error: +T17567StupidTheta.hs:6:1: error: [GHC-16220] • Uninferrable type variable k0 in the datatype context: forall (a :: k -> k0). (a b :: k0) ~ (a c :: k0) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7dde4754542b2c98d1aae3f58678347409221987...42a9733555c72f57194e230586f13522075724ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7dde4754542b2c98d1aae3f58678347409221987...42a9733555c72f57194e230586f13522075724ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 16:20:14 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 22 Mar 2023 12:20:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/23121 Message-ID: <641b2abe4b2a_90da35cce1bc6438d@gitlab.mail> Matthew Pickering pushed new branch wip/23121 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/23121 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 16:34:31 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 22 Mar 2023 12:34:31 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23142 Message-ID: <641b2e1754ddc_90da364b112c6476f1@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T23142 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23142 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 16:37:40 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 22 Mar 2023 12:37:40 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/T23142 Message-ID: <641b2ed4d72aa_90da365081706497d9@gitlab.mail> Krzysztof Gogolewski deleted branch wip/T23142 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 16:54:13 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 22 Mar 2023 12:54:13 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t23148 Message-ID: <641b32b51f1ea_90da36c0465465437f@gitlab.mail> Matthew Pickering pushed new branch wip/t23148 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t23148 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 18:58:30 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 22 Mar 2023 14:58:30 -0400 Subject: [Git][ghc/ghc][wip/T23153] Show an error when we cannot default a concrete tyvar Message-ID: <641b4fd6b044d_90da38bfc3bc704618@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23153 at Glasgow Haskell Compiler / GHC Commits: c318ddb7 by Krzysztof Gogolewski at 2023-03-22T19:58:06+01:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - 7 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Utils/Zonk.hs - compiler/GHC/Types/Error/Codes.hs - + testsuite/tests/rep-poly/T23153.hs - + testsuite/tests/rep-poly/T23153.stderr - testsuite/tests/rep-poly/all.T Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1453,6 +1453,11 @@ instance Diagnostic TcRnMessage where TcRnTyThingUsedWrong sort thing name -> mkSimpleDecorated $ pprTyThingUsedWrong sort thing name + TcRnCannotDefaultConcrete frr + -> mkSimpleDecorated $ + ppr (frr_context frr) $$ + text "cannot be assigned a fixed runtime representation," <+> + text "not even by defaulting." diagnosticReason = \case TcRnUnknownMessage m @@ -1931,6 +1936,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnTyThingUsedWrong{} -> ErrorWithoutFlag + TcRnCannotDefaultConcrete{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2427,6 +2434,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnTyThingUsedWrong{} -> noHints + TcRnCannotDefaultConcrete{} + -> [SuggestAddTypeSignatures UnnamedBinding] diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -3257,6 +3257,16 @@ data TcRnMessage where -> !Name -- ^ Name of the thing used wrongly. -> TcRnMessage + {- TcRnCannotDefaultConcrete is an error occurring when a concrete + type variable cannot be defaulted. + + Test cases: + T23153 + -} + TcRnCannotDefaultConcrete + :: !FixedRuntimeRepOrigin + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -56,6 +56,7 @@ import GHC.Tc.Utils.TcType import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) import GHC.Tc.Types.Evidence +import GHC.Tc.Errors.Types import GHC.Core.TyCo.Ppr ( pprTyVar ) import GHC.Core.TyCon @@ -1810,6 +1811,9 @@ commitFlexi flexi tv zonked_kind | isMultiplicityTy zonked_kind -> do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv) ; return manyDataConTy } + | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv + -> do { addErr $ TcRnCannotDefaultConcrete origin + ; return (anyTypeOfKind zonked_kind) } | otherwise -> do { traceTc "Defaulting flexi tyvar to Any:" (pprTyVar tv) ; return (anyTypeOfKind zonked_kind) } ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -539,6 +539,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnBadlyStaged" = 28914 GhcDiagnosticCode "TcRnStageRestriction" = 18157 GhcDiagnosticCode "TcRnTyThingUsedWrong" = 10969 + GhcDiagnosticCode "TcRnCannotDefaultConcrete" = 52083 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 ===================================== testsuite/tests/rep-poly/T23153.hs ===================================== @@ -0,0 +1,8 @@ +module T23153 where + +import GHC.Exts + +f :: forall r s (a :: TYPE (r s)). a -> () +f = f + +g h = f (h ()) ===================================== testsuite/tests/rep-poly/T23153.stderr ===================================== @@ -0,0 +1,15 @@ + +T23153.hs:8:1: error: [GHC-52083] + The argument ‘(h ())’ of ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23153.hs:8:1: error: [GHC-52083] + The argument ‘(h ())’ of ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23153.hs:8:1: error: [GHC-52083] + The argument ‘(h ())’ of ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -116,3 +116,4 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T23051', normal, compile_fail, ['']) +test('T23153', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c318ddb78ff7276c5721f26a530116ccd370be72 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c318ddb78ff7276c5721f26a530116ccd370be72 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 19:30:44 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 22 Mar 2023 15:30:44 -0400 Subject: [Git][ghc/ghc][master] Refactor the constraint solver pipeline Message-ID: <641b5764ca406_90da3952419c717267@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - 3 changed files: - compiler/GHC/Data/Bag.hs - compiler/GHC/Tc/Solver/Canonical.hs - + compiler/GHC/Tc/Solver/Dict.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0b8eaf3fc3d2ebbdcc86610b889930dbe5b4cdb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0b8eaf3fc3d2ebbdcc86610b889930dbe5b4cdb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 19:31:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 22 Mar 2023 15:31:43 -0400 Subject: [Git][ghc/ghc][master] Add structured error messages for GHC.Tc.Utils.TcMType Message-ID: <641b579fb99d5_90da396097107195bc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 26 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/dependent/should_fail/T11334b.stderr - testsuite/tests/dependent/should_fail/T14880-2.stderr - testsuite/tests/dependent/should_fail/T14880.stderr - testsuite/tests/dependent/should_fail/T15076.stderr - testsuite/tests/dependent/should_fail/T15076b.stderr - testsuite/tests/dependent/should_fail/T15825.stderr - testsuite/tests/patsyn/should_fail/T14552.stderr - testsuite/tests/patsyn/should_fail/T21479.stderr - testsuite/tests/polykinds/T15795.stderr - testsuite/tests/polykinds/T15795a.stderr - testsuite/tests/typecheck/no_skolem_info/T14040A.stderr - testsuite/tests/typecheck/should_fail/T14350.stderr - testsuite/tests/typecheck/should_fail/T15474.stderr - testsuite/tests/typecheck/should_fail/T15807.stderr - testsuite/tests/typecheck/should_fail/T16946.stderr - testsuite/tests/typecheck/should_fail/T17301.stderr - testsuite/tests/typecheck/should_fail/T17562.stderr - testsuite/tests/typecheck/should_fail/T17567.stderr - testsuite/tests/typecheck/should_fail/T17567StupidTheta.stderr Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -40,7 +40,7 @@ import GHC.Core.FamInstEnv ( FamInst(..), famInstAxiom, pprFamInst ) import GHC.Core.InstEnv import GHC.Core.TyCo.Rep (Type(..)) import GHC.Core.TyCo.Ppr (pprWithExplicitKindsWhen, - pprSourceTyCon, pprTyVars, pprWithTYPE) + pprSourceTyCon, pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType) import GHC.Core.PatSyn ( patSynName, pprPatSynType ) import GHC.Core.Predicate import GHC.Core.Type @@ -1453,6 +1453,34 @@ instance Diagnostic TcRnMessage where TcRnTyThingUsedWrong sort thing name -> mkSimpleDecorated $ pprTyThingUsedWrong sort thing name + TcRnCannotDefaultKindVar var knd -> + mkSimpleDecorated $ + (vcat [ text "Cannot default kind variable" <+> quotes (ppr var) + , text "of kind:" <+> ppr knd + , text "Perhaps enable PolyKinds or add a kind signature" ]) + TcRnUninferrableTyvar tidied_tvs context -> + mkSimpleDecorated $ + pprWithExplicitKindsWhen True $ + vcat [ text "Uninferrable type variable" + <> plural tidied_tvs + <+> pprWithCommas pprTyVar tidied_tvs + <+> text "in" + , pprUninferrableTyvarCtx context ] + TcRnSkolemEscape escapees tv orig_ty -> + mkSimpleDecorated $ + pprWithExplicitKindsWhen True $ + vcat [ sep [ text "Cannot generalise type; skolem" <> plural escapees + , quotes $ pprTyVars escapees + , text "would escape" <+> itsOrTheir escapees <+> text "scope" + ] + , sep [ text "if I tried to quantify" + , pprTyVar tv + , text "in this type:" + ] + , nest 2 (pprTidiedType orig_ty) + , text "(Indeed, I sometimes struggle even printing this correctly," + , text " due to its ill-scoped nature.)" + ] diagnosticReason = \case TcRnUnknownMessage m @@ -1931,6 +1959,12 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnTyThingUsedWrong{} -> ErrorWithoutFlag + TcRnCannotDefaultKindVar{} + -> ErrorWithoutFlag + TcRnUninferrableTyvar{} + -> ErrorWithoutFlag + TcRnSkolemEscape{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2427,6 +2461,12 @@ instance Diagnostic TcRnMessage where -> noHints TcRnTyThingUsedWrong{} -> noHints + TcRnCannotDefaultKindVar{} + -> noHints + TcRnUninferrableTyvar{} + -> noHints + TcRnSkolemEscape{} + -> noHints diagnosticCode = constructorCode @@ -4505,3 +4545,19 @@ pprStageCheckReason = \case text "instance for" <+> quotes (ppr t) StageCheckSplice t -> quotes (ppr t) + +pprUninferrableTyvarCtx :: UninferrableTyvarCtx -> SDoc +pprUninferrableTyvarCtx = \case + UninfTyCtx_ClassContext theta -> + sep [ text "the class context:", pprTheta theta ] + UninfTyCtx_DataContext theta -> + sep [ text "the datatype context:", pprTheta theta ] + UninfTyCtx_ProvidedContext theta -> + sep [ text "the provided context:" , pprTheta theta ] + UninfTyCtx_TyfamRhs rhs_ty -> + sep [ text "the type family equation right-hand side:" , ppr rhs_ty ] + UninfTyCtx_TysynRhs rhs_ty -> + sep [ text "the type synonym right-hand side:" , ppr rhs_ty ] + UninfTyCtx_Sig exp_kind full_hs_ty -> + hang (text "the kind" <+> ppr exp_kind) 2 + (text "of the type signature:" <+> ppr full_hs_ty) ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -94,6 +94,7 @@ module GHC.Tc.Errors.Types ( , HsigShapeMismatchReason(..) , WrongThingSort(..) , StageCheckReason(..) + , UninferrableTyvarCtx(..) ) where import GHC.Prelude @@ -3257,6 +3258,41 @@ data TcRnMessage where -> !Name -- ^ Name of the thing used wrongly. -> TcRnMessage + {-| TcRnCannotDefaultKindVar is an error that occurs when attempting to use + unconstrained kind variables whose type isn't @Type@, without -XPolyKinds. + + Test cases: + T11334b + -} + TcRnCannotDefaultKindVar + :: !TyVar -- ^ The unconstrained variable. + -> !Kind -- ^ Kind of the variable. + -> TcRnMessage + + {-| TcRnUninferrableTyvar is an error that occurs when metavariables + in a type could not be defaulted. + + Test cases: + T17301, T17562, T17567, T17567StupidTheta, T15474, T21479 + -} + TcRnUninferrableTyvar + :: ![TyCoVar] -- ^ The variables that could not be defaulted. + -> !UninferrableTyvarCtx -- ^ Description of the surrounding context. + -> TcRnMessage + + {-| TcRnSkolemEscape is an error that occurs when type variables from an + outer scope is used in a context where they should be locally scoped. + + Test cases: + T15076, T15076b, T14880-2, T15825, T14880, T15807, T16946, T14350, + T14040A, T15795, T15795a, T14552 + -} + TcRnSkolemEscape + :: ![TcTyVar] -- ^ The variables that would escape. + -> !TcTyVar -- ^ The variable that is being quantified. + -> !Type -- ^ The type in which they occur. + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -4538,3 +4574,11 @@ data WrongThingSort data StageCheckReason = StageCheckInstance !InstanceWhat !PredType | StageCheckSplice !Name + +data UninferrableTyvarCtx + = UninfTyCtx_ClassContext [TcType] + | UninfTyCtx_DataContext [TcType] + | UninfTyCtx_ProvidedContext [TcType] + | UninfTyCtx_TyfamRhs TcType + | UninfTyCtx_TysynRhs TcType + | UninfTyCtx_Sig TcType (LHsSigType GhcRn) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -473,7 +473,7 @@ tc_lhs_sig_type skol_info full_hs_ty@(L loc (HsSig { sig_bndrs = hs_outer_bndrs -- Default any unconstrained variables free in the kind -- See Note [Escaping kind in type signatures] ; exp_kind_dvs <- candidateQTyVarsOfType exp_kind - ; doNotQuantifyTyVars exp_kind_dvs (mk_doc exp_kind) + ; doNotQuantifyTyVars exp_kind_dvs (err_ctx exp_kind) ; traceTc "tc_lhs_sig_type" (ppr hs_outer_bndrs $$ ppr outer_bndrs) ; outer_bndrs <- scopedSortOuter outer_bndrs @@ -488,10 +488,9 @@ tc_lhs_sig_type skol_info full_hs_ty@(L loc (HsSig { sig_bndrs = hs_outer_bndrs ; return (implic, mkInfForAllTys kvs ty1) } where - mk_doc exp_kind tidy_env + err_ctx exp_kind tidy_env = do { (tidy_env2, exp_kind) <- zonkTidyTcType tidy_env exp_kind - ; return (tidy_env2, hang (text "The kind" <+> ppr exp_kind) - 2 (text "of type signature:" <+> ppr full_hs_ty)) } + ; return (tidy_env2, UninfTyCtx_Sig exp_kind full_hs_ty) } ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -35,7 +35,8 @@ import GHC.Driver.Config.HsToCore import GHC.Hs import GHC.Tc.Errors.Types ( TcRnMessage(..), FixedRuntimeRepProvenance(..) - , mkTcRnUnknownMessage, IllegalNewtypeReason (..) ) + , mkTcRnUnknownMessage, IllegalNewtypeReason (..) + , UninferrableTyvarCtx (..) ) import GHC.Tc.TyCl.Build import GHC.Tc.Solver( pushLevelAndSolveEqualities, pushLevelAndSolveEqualitiesX , reportUnsolvedEqualities ) @@ -2455,11 +2456,9 @@ tcClassDecl1 roles_info class_name hs_ctxt meths fundeps sigs ats at_defs -- class (forall a. a b ~ a c) => C b c -- The kind of `a` is unconstrained. ; dvs <- candidateQTyVarsOfTypes ctxt - ; let mk_doc tidy_env = do { (tidy_env2, ctxt) <- zonkTidyTcTypes tidy_env ctxt - ; return ( tidy_env2 - , sep [ text "the class context:" - , pprTheta ctxt ] ) } - ; doNotQuantifyTyVars dvs mk_doc + ; let err_ctx tidy_env = do { (tidy_env2, ctxt) <- zonkTidyTcTypes tidy_env ctxt + ; return (tidy_env2, UninfTyCtx_ClassContext ctxt) } + ; doNotQuantifyTyVars dvs err_ctx -- The pushLevelAndSolveEqualities will report errors for any -- unsolved equalities, so these zonks should not encounter @@ -2873,11 +2872,9 @@ tcTySynRhs roles_info tc_name hs_ty -- type T = forall a. Proxy a -- The kind of `a` is unconstrained. ; dvs <- candidateQTyVarsOfType rhs_ty - ; let mk_doc tidy_env = do { (tidy_env2, rhs_ty) <- zonkTidyTcType tidy_env rhs_ty - ; return ( tidy_env2 - , sep [ text "the type synonym right-hand side:" - , ppr rhs_ty ] ) } - ; doNotQuantifyTyVars dvs mk_doc + ; let err_ctx tidy_env = do { (tidy_env2, rhs_ty) <- zonkTidyTcType tidy_env rhs_ty + ; return (tidy_env2, UninfTyCtx_TysynRhs rhs_ty) } + ; doNotQuantifyTyVars dvs err_ctx ; ze <- mkEmptyZonkEnv NoFlexi ; (ze, bndrs) <- zonkTyVarBindersX ze tc_bndrs @@ -2918,12 +2915,10 @@ tcDataDefn err_ctxt roles_info tc_name -- data (forall a. a b ~ a c) => T b c -- The kind of 'a' is unconstrained. ; dvs <- candidateQTyVarsOfTypes stupid_tc_theta - ; let mk_doc tidy_env + ; let err_ctx tidy_env = do { (tidy_env2, theta) <- zonkTidyTcTypes tidy_env stupid_tc_theta - ; return ( tidy_env2 - , sep [ text "the datatype context:" - , pprTheta theta ] ) } - ; doNotQuantifyTyVars dvs mk_doc + ; return (tidy_env2, UninfTyCtx_DataContext theta) } + ; doNotQuantifyTyVars dvs err_ctx -- Check that we don't use kind signatures without the extension ; kind_signatures <- xoptM LangExt.KindSignatures @@ -3178,12 +3173,10 @@ tcTyFamInstEqnGuts fam_tc mb_clsinfo outer_hs_bndrs hs_pats hs_rhs_ty -- See Note [Error on unconstrained meta-variables] in GHC.Tc.Utils.TcMType -- Example: typecheck/should_fail/T17301 ; dvs_rhs <- candidateQTyVarsOfType rhs_ty - ; let mk_doc tidy_env + ; let err_ctx tidy_env = do { (tidy_env2, rhs_ty) <- zonkTidyTcType tidy_env rhs_ty - ; return ( tidy_env2 - , sep [ text "type family equation right-hand side:" - , ppr rhs_ty ] ) } - ; doNotQuantifyTyVars dvs_rhs mk_doc + ; return (tidy_env2, UninfTyCtx_TyfamRhs rhs_ty) } + ; doNotQuantifyTyVars dvs_rhs err_ctx ; ze <- mkEmptyZonkEnv NoFlexi ; (ze, final_tvs) <- zonkTyBndrsX ze final_tvs ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -194,12 +194,10 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details -- Report un-quantifiable type variables: -- see Note [Unquantified tyvars in a pattern synonym] ; dvs <- candidateQTyVarsOfTypes prov_theta - ; let mk_doc tidy_env + ; let err_ctx tidy_env = do { (tidy_env2, theta) <- zonkTidyTcTypes tidy_env prov_theta - ; return ( tidy_env2 - , sep [ text "the provided context:" - , pprTheta theta ] ) } - ; doNotQuantifyTyVars dvs mk_doc + ; return ( tidy_env2, UninfTyCtx_ProvidedContext theta ) } + ; doNotQuantifyTyVars dvs err_ctx ; traceTc "tcInferPatSynDecl }" $ (ppr name $$ ppr ex_tvs) ; rec_fields <- lookupConstructorFields name ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -131,7 +131,6 @@ import GHC.Types.Name import GHC.Types.Var.Set import GHC.Builtin.Types -import GHC.Types.Error import GHC.Types.Var.Env import GHC.Types.Unique.Set import GHC.Types.Basic ( TypeOrKind(..) @@ -1853,10 +1852,7 @@ defaultTyVar def_strat tv ; writeMetaTyVar kv liftedTypeKind ; return True } | otherwise - = do { addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ - (vcat [ text "Cannot default kind variable" <+> quotes (ppr kv') - , text "of kind:" <+> ppr (tyVarKind kv') - , text "Perhaps enable PolyKinds or add a kind signature" ]) + = do { addErr $ TcRnCannotDefaultKindVar kv' (tyVarKind kv') -- We failed to default it, so return False to say so. -- Hence, it'll get skolemised. That might seem odd, but we must either -- promote, skolemise, or zap-to-Any, to satisfy GHC.Tc.Gen.HsType @@ -2053,7 +2049,7 @@ C. Examine the class declaration at the top of this Note again. -} doNotQuantifyTyVars :: CandidatesQTvs - -> (TidyEnv -> TcM (TidyEnv, SDoc)) + -> (TidyEnv -> TcM (TidyEnv, UninferrableTyvarCtx)) -- ^ like "the class context (D a b, E foogle)" -> TcM () -- See Note [Error on unconstrained meta-variables] @@ -2072,14 +2068,7 @@ doNotQuantifyTyVars dvs where_found ; unless (null leftover_metas) $ do { let (tidy_env1, tidied_tvs) = tidyOpenTyCoVars emptyTidyEnv leftover_metas ; (tidy_env2, where_doc) <- where_found tidy_env1 - ; let msg = mkTcRnUnknownMessage $ - mkPlainError noHints $ - pprWithExplicitKindsWhen True $ - vcat [ text "Uninferrable type variable" - <> plural tidied_tvs - <+> pprWithCommas pprTyVar tidied_tvs - <+> text "in" - , where_doc ] + ; let msg = TcRnUninferrableTyvar tidied_tvs where_doc ; failWithTcM (tidy_env2, msg) } ; traceTc "doNotQuantifyTyVars success" empty } @@ -2741,21 +2730,8 @@ naughtyQuantification orig_ty tv escapees -- variables; very confusing to users! orig_ty' = tidyType env orig_ty1 - ppr_tidied = pprTyVars . map (tidyTyCoVarOcc env) - msg = mkTcRnUnknownMessage $ mkPlainError noHints $ - pprWithExplicitKindsWhen True $ - vcat [ sep [ text "Cannot generalise type; skolem" <> plural escapees' - , quotes $ ppr_tidied escapees' - , text "would escape" <+> itsOrTheir escapees' <+> text "scope" - ] - , sep [ text "if I tried to quantify" - , ppr_tidied [tv] - , text "in this type:" - ] - , nest 2 (pprTidiedType orig_ty') - , text "(Indeed, I sometimes struggle even printing this correctly," - , text " due to its ill-scoped nature.)" - ] + tidied = map (tidyTyCoVarOcc env) escapees' + msg = TcRnSkolemEscape tidied (tidyTyCoVarOcc env tv) orig_ty' ; failWithTcM (env, msg) } ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -539,6 +539,9 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnBadlyStaged" = 28914 GhcDiagnosticCode "TcRnStageRestriction" = 18157 GhcDiagnosticCode "TcRnTyThingUsedWrong" = 10969 + GhcDiagnosticCode "TcRnCannotDefaultKindVar" = 79924 + GhcDiagnosticCode "TcRnUninferrableTyvar" = 16220 + GhcDiagnosticCode "TcRnSkolemEscape" = 71451 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 ===================================== testsuite/tests/dependent/should_fail/T11334b.stderr ===================================== @@ -1,5 +1,5 @@ -T11334b.hs:8:14: error: +T11334b.hs:8:14: error: [GHC-79924] • Cannot default kind variable ‘a0’ of kind: k10 Perhaps enable PolyKinds or add a kind signature @@ -7,7 +7,7 @@ T11334b.hs:8:14: error: In the expression: Proxy :: Proxy 'Compose In an equation for ‘p’: p = Proxy :: Proxy 'Compose -T11334b.hs:8:14: error: +T11334b.hs:8:14: error: [GHC-79924] • Cannot default kind variable ‘g0’ of kind: k10 -> k0 Perhaps enable PolyKinds or add a kind signature @@ -15,7 +15,7 @@ T11334b.hs:8:14: error: In the expression: Proxy :: Proxy 'Compose In an equation for ‘p’: p = Proxy :: Proxy 'Compose -T11334b.hs:8:14: error: +T11334b.hs:8:14: error: [GHC-79924] • Cannot default kind variable ‘f0’ of kind: k0 -> * Perhaps enable PolyKinds or add a kind signature ===================================== testsuite/tests/dependent/should_fail/T14880-2.stderr ===================================== @@ -1,5 +1,5 @@ -T14880-2.hs:13:9: error: +T14880-2.hs:13:9: error: [GHC-71451] • Cannot generalise type; skolem ‘arg’ would escape its scope if I tried to quantify (a0 :: arg) in this type: forall arg. Proxy @{Proxy @{arg} a0 -> *} (Foo arg @a0) -> () ===================================== testsuite/tests/dependent/should_fail/T14880.stderr ===================================== @@ -1,5 +1,5 @@ -T14880.hs:13:5: error: +T14880.hs:13:5: error: [GHC-71451] • Cannot generalise type; skolem ‘arg’ would escape its scope if I tried to quantify (a0 :: arg) in this type: forall x arg. ===================================== testsuite/tests/dependent/should_fail/T15076.stderr ===================================== @@ -1,5 +1,5 @@ -T15076.hs:11:8: error: +T15076.hs:11:8: error: [GHC-71451] • Cannot generalise type; skolem ‘a’ would escape its scope if I tried to quantify (x0 :: a) in this type: forall a (f :: forall (x :: a). Proxy @{a} x -> *). ===================================== testsuite/tests/dependent/should_fail/T15076b.stderr ===================================== @@ -1,4 +1,4 @@ -T15076b.hs:9:8: error: +T15076b.hs:9:8: error: [GHC-71451] • Cannot generalise type; skolem ‘a’ would escape its scope if I tried to quantify (x0 :: a) in this type: forall a (f :: forall (x :: a). Proxy @{a} x -> *). ===================================== testsuite/tests/dependent/should_fail/T15825.stderr ===================================== @@ -1,5 +1,5 @@ -T15825.hs:14:10: error: +T15825.hs:14:10: error: [GHC-71451] • Cannot generalise type; skolem ‘k’ would escape its scope if I tried to quantify (x0 :: k) in this type: forall k (a :: C k). X (a @x0) ===================================== testsuite/tests/patsyn/should_fail/T14552.stderr ===================================== @@ -1,5 +1,5 @@ -T14552.hs:22:1: error: +T14552.hs:22:1: error: [GHC-71451] • Cannot generalise type; skolem ‘k’ would escape its scope if I tried to quantify (t0 :: k) in this type: forall k (w :: k --> *). Exp a0 (F @k @(*) w t0) ===================================== testsuite/tests/patsyn/should_fail/T21479.stderr ===================================== @@ -1,5 +1,5 @@ -T21479.hs:13:1: error: +T21479.hs:13:1: error: [GHC-16220] • Uninferrable type variable a0 in the provided context: (a0 :: *) ~ (Int :: *) • In the declaration for pattern synonym ‘T1’ ===================================== testsuite/tests/polykinds/T15795.stderr ===================================== @@ -1,5 +1,5 @@ -T15795.hs:12:3: error: +T15795.hs:12:3: error: [GHC-71451] • Cannot generalise type; skolem ‘k’ would escape its scope if I tried to quantify (a0 :: k) in this type: forall k (b :: k). T @k @a0 b ===================================== testsuite/tests/polykinds/T15795a.stderr ===================================== @@ -1,5 +1,5 @@ -T15795a.hs:9:3: error: +T15795a.hs:9:3: error: [GHC-71451] • Cannot generalise type; skolem ‘u’ would escape its scope if I tried to quantify (cat10 :: u) in this type: forall u (a :: u). F @u @cat10 a ===================================== testsuite/tests/typecheck/no_skolem_info/T14040A.stderr ===================================== @@ -1,5 +1,5 @@ -T14040A.hs:13:8: error: +T14040A.hs:13:8: error: [GHC-71451] • Cannot generalise type; skolem ‘a’ would escape its scope if I tried to quantify (x0 :: a) in this type: forall a (f :: forall (x :: a). Proxy @{a} x -> *). ===================================== testsuite/tests/typecheck/should_fail/T14350.stderr ===================================== @@ -1,5 +1,5 @@ -T14350.hs:49:10: error: +T14350.hs:49:10: error: [GHC-71451] • Cannot generalise type; skolem ‘a’ would escape its scope if I tried to quantify (x0 :: a) in this type: forall a (b1 :: a ~> *) ===================================== testsuite/tests/typecheck/should_fail/T15474.stderr ===================================== @@ -1,5 +1,5 @@ -T15474.hs:10:1: error: +T15474.hs:10:1: error: [GHC-16220] • Uninferrable type variable k0 in the type synonym right-hand side: forall (t :: k0). Proxy @{k0} t • In the type declaration for ‘Forall’ ===================================== testsuite/tests/typecheck/should_fail/T15807.stderr ===================================== @@ -1,5 +1,5 @@ -T15807.hs:12:3: error: +T15807.hs:12:3: error: [GHC-71451] • Cannot generalise type; skolem ‘f’ would escape its scope if I tried to quantify (f0 :: f -> *) in this type: forall f (a :: f). f a %1 -> App @f @f0 a ===================================== testsuite/tests/typecheck/should_fail/T16946.stderr ===================================== @@ -1,5 +1,5 @@ -T16946.hs:11:9: error: +T16946.hs:11:9: error: [GHC-71451] • Cannot generalise type; skolem ‘k’ would escape its scope if I tried to quantify (y0 :: k) in this type: forall k (c :: k -> k -> *) ===================================== testsuite/tests/typecheck/should_fail/T17301.stderr ===================================== @@ -1,5 +1,6 @@ -T17301.hs:22:3: error: +T17301.hs:22:3: error: [GHC-16220] • Uninferrable type variable (a0 :: A) in - type family equation right-hand side: MkATySing @(B a0) (SB @a0) + the type family equation right-hand side: + MkATySing @(B a0) (SB @a0) • In the type family declaration for ‘Forget’ ===================================== testsuite/tests/typecheck/should_fail/T17562.stderr ===================================== @@ -1,5 +1,5 @@ -T17562.hs:7:1: error: +T17562.hs:7:1: error: [GHC-16220] • Uninferrable type variable k0 in the class context: forall (a :: k -> k0). (a b :: k0) ~ (a c :: k0) • In the class declaration for ‘C’ ===================================== testsuite/tests/typecheck/should_fail/T17567.stderr ===================================== @@ -1,5 +1,5 @@ -T17567.hs:7:1: error: +T17567.hs:7:1: error: [GHC-16220] • Uninferrable type variable k0 in the type synonym right-hand side: forall (a :: k0). Proxy @{k0} a • In the type declaration for ‘T’ ===================================== testsuite/tests/typecheck/should_fail/T17567StupidTheta.stderr ===================================== @@ -2,7 +2,7 @@ T17567StupidTheta.hs:1:37: warning: [-Wdeprecated-flags (in -Wdefault)] -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. -T17567StupidTheta.hs:6:1: error: +T17567StupidTheta.hs:6:1: error: [GHC-16220] • Uninferrable type variable k0 in the datatype context: forall (a :: k -> k0). (a b :: k0) ~ (a c :: k0) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cedf9a3b7a74a7c1c09e8b994edc40a2447dae08 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cedf9a3b7a74a7c1c09e8b994edc40a2447dae08 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 19:32:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 22 Mar 2023 15:32:17 -0400 Subject: [Git][ghc/ghc][master] Testsuite: use js_skip for T2615 (#22374) Message-ID: <641b57c15cbdf_90da398e7108724371@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 1 changed file: - testsuite/tests/rts/linker/all.T Changes: ===================================== testsuite/tests/rts/linker/all.T ===================================== @@ -28,7 +28,9 @@ test('T23066', # Test to see if linker scripts link properly to real ELF files test('T2615', [extra_files(['libfoo_T2615.c', 'libfoo_script_T2615.so']), - js_broken(22374), + # JavaScript linker doesn't support linker scripts + js_skip, + # Windows linker doesn't seem to support linker scripts when(opsys('mingw32'), skip), # OS X doesn't seem to support linker scripts when(opsys('darwin'), skip), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30d45e971d94b3c28296a3f20f94275f38bc89d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30d45e971d94b3c28296a3f20f94275f38bc89d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 19:45:07 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 22 Mar 2023 15:45:07 -0400 Subject: [Git][ghc/ghc][wip/T23153] 4 commits: Refactor the constraint solver pipeline Message-ID: <641b5ac375a8f_90da39c69e207247c4@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23153 at Glasgow Haskell Compiler / GHC Commits: e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 0d2fb1b8 by Krzysztof Gogolewski at 2023-03-22T20:44:47+01:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - 6 changed files: - compiler/GHC/Data/Bag.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs - + compiler/GHC/Tc/Solver/Dict.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c318ddb78ff7276c5721f26a530116ccd370be72...0d2fb1b848a441894e827b65158287ece9f6ffaf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c318ddb78ff7276c5721f26a530116ccd370be72...0d2fb1b848a441894e827b65158287ece9f6ffaf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 19:49:34 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 22 Mar 2023 15:49:34 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/static-gadt-con-info Message-ID: <641b5bce88669_90da39ecf6747251d5@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/static-gadt-con-info at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/static-gadt-con-info You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 19:51:58 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 22 Mar 2023 15:51:58 -0400 Subject: [Git][ghc/ghc][wip/romes/static-gadt-con-info] fix: Better accounting for voidrep representations Message-ID: <641b5c5eba16f_90da39ecf7147285ba@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/static-gadt-con-info at Glasgow Haskell Compiler / GHC Commits: 2304d2f2 by romes at 2023-03-22T19:51:48+00:00 fix: Better accounting for voidrep representations Fixes #23158 - - - - - 2 changed files: - compiler/GHC/Core/DataCon.hs - + compiler/GHC/Types/RepType.hs-boot Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -88,6 +88,7 @@ import GHC.Core.Predicate import GHC.Types.Var import GHC.Types.Var.Env import GHC.Types.Basic +import {-# SOURCE #-} GHC.Types.RepType (isZeroBitTy) import GHC.Data.FastString import GHC.Unit.Types import GHC.Utils.Binary @@ -1675,7 +1676,7 @@ dataConRepArgTys (MkData { dcRep = rep , dcOrigArgTys = orig_arg_tys , dcRepTyCon = tc }) = case rep of - DCR { dcr_arg_tys = arg_tys } -> arg_tys + DCR { dcr_arg_tys = arg_tys } -> filter (isZeroBitTy . scaledThing) arg_tys NoDataConRep | isTypeDataTyCon tc -> assert (null theta) $ orig_arg_tys ===================================== compiler/GHC/Types/RepType.hs-boot ===================================== @@ -0,0 +1,8 @@ +module GHC.Types.RepType where + +import GHC.Utils.Misc +import GHC.Core.TyCo.Rep +import Data.Bool + +isZeroBitTy :: HasDebugCallStack => Type -> Bool + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2304d2f24a96dd4574a6eab7dbacc69799a4e24d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2304d2f24a96dd4574a6eab7dbacc69799a4e24d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 21:01:57 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Wed, 22 Mar 2023 17:01:57 -0400 Subject: [Git][ghc/ghc][wip/amg/warning-categories] 12 commits: Allow LLVM backend to use HDoc for faster file generation. Message-ID: <641b6cc5cf227_90da3b6ef5887436f2@gitlab.mail> Adam Gundry pushed to branch wip/amg/warning-categories at Glasgow Haskell Compiler / GHC Commits: e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - ab38b95b by Adam Gundry at 2023-03-22T21:01:21+00:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - e74100e7 by Adam Gundry at 2023-03-22T21:01:21+00:00 Move mention of warning groups change to 9.8.1 release notes - - - - - 25 changed files: - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ed49d0d85fca01f05502581f483a6607ebe8560...e74100e7d0902908b748f6cfdda7bd62d93b21c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ed49d0d85fca01f05502581f483a6607ebe8560...e74100e7d0902908b748f6cfdda7bd62d93b21c1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 21:32:04 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Wed, 22 Mar 2023 17:32:04 -0400 Subject: [Git][ghc/ghc][wip/amg/warning-categories] 2 commits: Allow WARNING pragmas to be controlled with custom categories Message-ID: <641b73d465ff0_90da3bfbfe1075217e@gitlab.mail> Adam Gundry pushed to branch wip/amg/warning-categories at Glasgow Haskell Compiler / GHC Commits: ddac28f1 by Adam Gundry at 2023-03-22T21:31:57+00:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 4e751ae5 by Adam Gundry at 2023-03-22T21:31:57+00:00 Move mention of warning groups change to 9.8.1 release notes - - - - - 30 changed files: - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/using-warnings.rst - testsuite/tests/parser/should_compile/T3303.stderr - testsuite/tests/rename/should_compile/T5867.stderr - testsuite/tests/rename/should_compile/rn050.stderr - testsuite/tests/rename/should_compile/rn066.stderr - testsuite/tests/rename/should_fail/T5281.stderr - testsuite/tests/warnings/should_compile/DeprU.stderr - + testsuite/tests/warnings/should_fail/WarningCategory1.hs - + testsuite/tests/warnings/should_fail/WarningCategory1.stderr - + testsuite/tests/warnings/should_fail/WarningCategory1_B.hs - + testsuite/tests/warnings/should_fail/WarningCategory2.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e74100e7d0902908b748f6cfdda7bd62d93b21c1...4e751ae58e5ee71ccef3c411fb50c91e5bd90eca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e74100e7d0902908b748f6cfdda7bd62d93b21c1...4e751ae58e5ee71ccef3c411fb50c91e5bd90eca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 22:07:43 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 22 Mar 2023 18:07:43 -0400 Subject: [Git][ghc/ghc][wip/romes/static-gadt-con-info] Account for all VoidRep types on precomputedStaticConInfo Message-ID: <641b7c2f6cd84_90da3c4b59387604dc@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/static-gadt-con-info at Glasgow Haskell Compiler / GHC Commits: be3f199f by romes at 2023-03-22T21:53:08+00:00 Account for all VoidRep types on precomputedStaticConInfo Previously, we were considering coercion values whose unlifted type equality had a zerobit runtime representation (VoidRep) to be constructor arguments when determining whether we should pre-compute a staticConInfo for a data constructor. This made it so that GADT constructors with type-equality constraints that should have no runtime representation actually ended up impacting the code generation. Fixes #23158 - - - - - 1 changed file: - compiler/GHC/StgToCmm/DataCon.hs Changes: ===================================== compiler/GHC/StgToCmm/DataCon.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Id.Info( CafInfo( NoCafRefs ) ) import GHC.Types.Name (isInternalName) -import GHC.Types.RepType (countConRepArgs) +import GHC.Types.RepType (countConRepArgs, isZeroBitTy) import GHC.Types.Literal import GHC.Builtin.Utils import GHC.Utils.Panic @@ -327,7 +327,7 @@ because they don't support cross package data references well. precomputedStaticConInfo_maybe :: StgToCmmConfig -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo precomputedStaticConInfo_maybe cfg binder con [] -- Nullary constructors - | isNullaryRepDataCon con + | isStgNullaryDataCon con = Just $ litIdInfo (stgToCmmPlatform cfg) binder (mkConLFInfo con) (CmmLabel (mkClosureLabel (dataConName con) NoCafRefs)) precomputedStaticConInfo_maybe cfg binder con [arg] @@ -371,6 +371,15 @@ precomputedStaticConInfo_maybe cfg binder con [arg] | charClosure = "stg_CHARLIKE" | otherwise = panic "precomputedStaticConInfo_maybe: Unknown closure type" + -- morally equivalent to (isNullaryRepDataCon con) at the Stg level, where we + -- doesn't consider types with no runtime representation to be constructor arguments. + -- + -- isNullaryRepDataCon is not fit for checking whether the constructor is + -- nullary at the Stg level because the function 'dataConRepArgTys' it + -- depends on includes unlifted type equalities, whose runtime + -- representation is 'VoidRep', in the returned list. + isStgNullaryDataCon = null . filter (isZeroBitTy . scaledThing) . dataConRepArgTys + precomputedStaticConInfo_maybe _ _ _ _ = Nothing --------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be3f199fd4013d75a8ae6769fda98c143e677f00 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be3f199fd4013d75a8ae6769fda98c143e677f00 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 22:10:02 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 22 Mar 2023 18:10:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23146 Message-ID: <641b7cba60b30_90da3c4b593876092e@gitlab.mail> Ben Gamari pushed new branch wip/T23146 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23146 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 22:11:30 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 22 Mar 2023 18:11:30 -0400 Subject: [Git][ghc/ghc][wip/T23146] 10 commits: Bump Win32 to 2.13.4.0 Message-ID: <641b7d122ec67_90da3c5f102c7611b0@gitlab.mail> Ben Gamari pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - d871e8a4 by Ben Gamari at 2023-03-22T18:10:34-04:00 codeGen: Fix some Haddocks - - - - - a69cab40 by Ben Gamari at 2023-03-22T18:10:34-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - f26b6259 by Ben Gamari at 2023-03-22T18:11:24-04:00 testsuite: Add test for #23146 - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Monad.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Shape.hs - docs/users_guide/9.8.1-notes.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs - libraries/Win32 - libraries/ghc-bignum/ghc-bignum.cabal - m4/fp_find_cxx_std_lib.m4 - testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr - testsuite/tests/backpack/should_fail/bkpfail01.stderr - testsuite/tests/backpack/should_fail/bkpfail05.stderr - testsuite/tests/backpack/should_fail/bkpfail09.stderr - testsuite/tests/backpack/should_fail/bkpfail16.stderr - testsuite/tests/backpack/should_fail/bkpfail20.stderr - testsuite/tests/backpack/should_fail/bkpfail21.stderr - testsuite/tests/backpack/should_fail/bkpfail35.stderr - testsuite/tests/backpack/should_fail/bkpfail37.stderr - testsuite/tests/backpack/should_fail/bkpfail38.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5e13c0327ee63cc6dc7ecec69cb06b60bb3b3f0...f26b625943f579c5816e4788611f7478ed6863c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5e13c0327ee63cc6dc7ecec69cb06b60bb3b3f0...f26b625943f579c5816e4788611f7478ed6863c5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 22:22:52 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 22 Mar 2023 18:22:52 -0400 Subject: [Git][ghc/ghc][wip/T22696] validDerivPred: Reject non-type-variable constraints in IrredPreds Message-ID: <641b7fbc8f3d5_90da3ccc678077115d@gitlab.mail> Ryan Scott pushed to branch wip/T22696 at Glasgow Haskell Compiler / GHC Commits: 100f0eb7 by Ryan Scott at 2023-03-22T18:22:40-04:00 validDerivPred: Reject non-type-variable constraints in IrredPreds This brings the `IrredPred` case in sync with the general wisdom in `Note [Exotic derived instance contexts]`. Namely, we should reject arbitrarily complex constraints that are inferred from `deriving` clauses. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if it is, there is a clear migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 8 changed files: - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Validity.hs - docs/users_guide/9.8.1-notes.rst - + testsuite/tests/deriving/should_compile/T22696.hs - testsuite/tests/deriving/should_compile/all.T - testsuite/tests/deriving/should_compile/T14339.hs → testsuite/tests/deriving/should_fail/T14339.hs - + testsuite/tests/deriving/should_fail/T14339.stderr - testsuite/tests/deriving/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Deriv/Infer.hs ===================================== @@ -1057,13 +1057,41 @@ case where we really want that instance decl for C. So for now we simply require that the derived instance context should have only type-variable constraints. -Here is another example: - data Fix f = In (f (Fix f)) deriving( Eq ) -Here, if we are prepared to allow -XUndecidableInstances we -could derive the instance +Here are some other notable examples: + +* data Fix f = In (f (Fix f)) deriving( Eq ) + + Here, if we are prepared to allow -XUndecidableInstances we + could derive the instance + instance Eq (f (Fix f)) => Eq (Fix f) -but this is so delicate that I don't think it should happen inside -'deriving'. If you want this, write it yourself! + + but this is so delicate that I don't think it should happen inside + 'deriving'. If you want this, write it yourself using StandaloneDeriving! + +* Derived instances whose instance context would mention TypeError, such + as the code from the deriving/should_fail/T14339 test case: + + newtype Foo = Foo Int + + class Bar a where + bar :: a + + instance (TypeError (Text "Boo")) => Bar Foo where + bar = undefined + + newtype Baz = Baz Foo + deriving Bar + + The `deriving Bar` clause would generate this instance: + + instance TypeError (Text "Boo") => Bar Baz + + Because `TypeError ...` is not a type-variable constraint, we reject it. This + has the desirable side effect of causing the TypeError to fire in the + resulting error message. Again, if you want a derived instance like this, you + will have to write it yourself using StandaloneDeriving. (See + deriving/should_compile/T22696 for an example of this.) NB: if you want to lift this condition, make sure you still meet the termination conditions! If not, the deriving mechanism generates ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -1762,14 +1762,26 @@ validDerivPred head_size pred visible_tys = filterOutInvisibleTypes (classTyCon cls) tys -- (VD2) IrredPred {} -> check_size (pSizeType pred) - -- Very important that we do the "too many variable occurrences" - -- check here, via check_size. Example (test T21302): + && isEmptyUniqSet (tyConsOfType pred) + -- The reasons why we each of these conditions: + -- + -- - `check_size (pSizeType pred)`: + -- + -- This perform a "too many variable occurrences" check via + -- check_size. Example (test T21302): + -- -- instance c Eq a => Eq (BoxAssoc a) -- data BAD = BAD (BoxAssoc Int) deriving( Eq ) - -- We don't want to accept an inferred predicate (c0 Eq Int) + -- + -- We don't want to accept an inferred predicate (c0 Eq Int) -- from that `deriving(Eq)` clause, because the c0 is fresh, -- so we'll think it's a "new" one, and loop in - -- GHC.Tc.Deriv.Infer.simplifyInstanceContexts + -- GHC.Tc.Deriv.Infer.simplifyInstanceContexts. + -- + -- - `isEmptyUniqSet (tyConsOfType pred)`: + -- + -- This checks that the predicate does not mention any type + -- constructors. See Note [Exotic derived instance contexts]. where check_size pred_size = isNothing (pred_size `ltPatersonSize` head_size) ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -35,6 +35,31 @@ Compiler - Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``. See GHC ticket #23049. +- Data types with ``deriving`` clauses now reject inferred instance contexts + that mention ``TypeError`` constraints (see :ref:`custom-errors`), such as + this one: :: + + newtype Foo = Foo Int + + class Bar a where + bar :: a + + instance (TypeError (Text "Boo")) => Bar Foo where + bar = undefined + + newtype Baz = Baz Foo + deriving Bar + + Here, the derived ``Bar`` instance for ``Baz`` would look like this: :: + + instance TypeError (Text "Boo") => Bar Baz + + While GHC would accept this before, GHC 9.8 now rejects it, emitting "``Boo``" + in the resulting error message. If you really want to derive this instance and + defer the error to sites where the instance is used, you must do so manually + with :extension:`StandaloneDeriving`, e.g. :: + + deriving instance TypeError (Text "Boo") => Bar Baz GHCi ~~~~ ===================================== testsuite/tests/deriving/should_compile/T22696.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE UndecidableInstances #-} +module T22696 where + +import GHC.TypeLits + +newtype Foo = Foo Int + +class Bar a where + bar :: a + +instance (TypeError (Text "Boo")) => Bar Foo where + bar = undefined + +newtype Baz = Baz Foo + +deriving instance TypeError (Text "Boo") => Bar Baz ===================================== testsuite/tests/deriving/should_compile/all.T ===================================== @@ -101,7 +101,6 @@ test('T13919', normal, compile, ['']) test('T13998', normal, compile, ['']) test('T14045b', normal, compile, ['']) test('T14094', normal, compile, ['']) -test('T14339', normal, compile, ['']) test('T14331', normal, compile, ['']) test('T14332', normal, compile, ['']) test('T14578', normal, compile, ['-ddump-deriv -dsuppress-uniques']) @@ -140,3 +139,4 @@ test('T20501', normal, compile, ['']) test('T20719', normal, compile, ['']) test('T20994', normal, compile, ['']) test('T22167', normal, compile, ['']) +test('T22696', normal, compile, ['']) ===================================== testsuite/tests/deriving/should_compile/T14339.hs → testsuite/tests/deriving/should_fail/T14339.hs ===================================== @@ -16,10 +16,10 @@ instance (TypeError (Text "Boo")) => Bar Foo where newtype Baz = Baz Foo deriving Bar --- Apparently we derive +-- We derive: +-- -- instance TypeError (Text "Boo") => Bar Baz -- --- Is that really what we want? It defers the type --- error... surely we should use standalone deriving --- if that is what we want? --- See GHC.Tc.Validity.validDerivPred and #22696. \ No newline at end of file +-- And error out due to the TypeError. See also deriving/should_compile/T22696, +-- which uses StandaloneDeriving to write a valid instance with a TypeError +-- constraint in its instance context. ===================================== testsuite/tests/deriving/should_fail/T14339.stderr ===================================== @@ -0,0 +1,4 @@ + +T14339.hs:17:12: error: [GHC-64725] + • Boo + • When deriving the instance for (Bar Baz) ===================================== testsuite/tests/deriving/should_fail/all.T ===================================== @@ -69,6 +69,7 @@ test('T12801', normal, compile_fail, ['']) test('T13154c', normal, compile_fail, ['']) test('T14365', [extra_files(['T14365B.hs','T14365B.hs-boot'])], multimod_compile_fail, ['T14365A','']) +test('T14339', normal, compile_fail, ['']) test('T14728a', normal, compile_fail, ['']) test('T14728b', normal, compile_fail, ['']) test('T14916', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/100f0eb7a8f178d0dfc5213ac12cf9a66f309f3d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/100f0eb7a8f178d0dfc5213ac12cf9a66f309f3d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 22:34:14 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 22 Mar 2023 18:34:14 -0400 Subject: [Git][ghc/ghc][wip/romes/static-gadt-con-info] Account for all VoidRep types on precomputedStaticConInfo Message-ID: <641b8266b27ed_90da3d2629147716d4@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/static-gadt-con-info at Glasgow Haskell Compiler / GHC Commits: 12f9387a by romes at 2023-03-22T22:34:06+00:00 Account for all VoidRep types on precomputedStaticConInfo Previously, we were considering coercion values whose unlifted type equality had a zerobit runtime representation (VoidRep) to be constructor arguments when determining whether we should pre-compute a staticConInfo for a data constructor. This made it so that GADT constructors with type-equality constraints that should have no runtime representation actually ended up impacting the code generation. Fixes #23158 - - - - - 1 changed file: - compiler/GHC/StgToCmm/DataCon.hs Changes: ===================================== compiler/GHC/StgToCmm/DataCon.hs ===================================== @@ -37,11 +37,12 @@ import GHC.Runtime.Heap.Layout import GHC.Types.CostCentre import GHC.Unit import GHC.Core.DataCon +import GHC.Core.TyCo.Rep (scaledThing) import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Id.Info( CafInfo( NoCafRefs ) ) import GHC.Types.Name (isInternalName) -import GHC.Types.RepType (countConRepArgs) +import GHC.Types.RepType (countConRepArgs, isZeroBitTy) import GHC.Types.Literal import GHC.Builtin.Utils import GHC.Utils.Panic @@ -327,9 +328,19 @@ because they don't support cross package data references well. precomputedStaticConInfo_maybe :: StgToCmmConfig -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo precomputedStaticConInfo_maybe cfg binder con [] -- Nullary constructors - | isNullaryRepDataCon con + | isStgNullaryDataCon con = Just $ litIdInfo (stgToCmmPlatform cfg) binder (mkConLFInfo con) (CmmLabel (mkClosureLabel (dataConName con) NoCafRefs)) + where + -- morally equivalent to (isNullaryRepDataCon con) at the Stg level, where we + -- doesn't consider types with no runtime representation to be constructor arguments. + -- + -- isNullaryRepDataCon is not fit for checking whether the constructor is + -- nullary at the Stg level because the function 'dataConRepArgTys' it + -- depends on includes unlifted type equalities, whose runtime + -- representation is 'VoidRep', in the returned list. + isStgNullaryDataCon = null . filter (isZeroBitTy . scaledThing) . dataConRepArgTys + precomputedStaticConInfo_maybe cfg binder con [arg] -- Int/Char values with existing closures in the RTS | intClosure || charClosure View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/12f9387ab8599333cfe599f614ceec5f8762da1b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/12f9387ab8599333cfe599f614ceec5f8762da1b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 22:43:40 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 22 Mar 2023 18:43:40 -0400 Subject: [Git][ghc/ghc][wip/romes/static-gadt-con-info] Account for all VoidRep types on precomputedStaticConInfo Message-ID: <641b849c73cb5_90da3d569c987719e7@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/static-gadt-con-info at Glasgow Haskell Compiler / GHC Commits: c26f67d3 by romes at 2023-03-22T22:43:24+00:00 Account for all VoidRep types on precomputedStaticConInfo Previously, we were considering coercion values whose unlifted type equality had a zerobit runtime representation (VoidRep) to be constructor arguments when determining whether we should pre-compute a staticConInfo for a data constructor. This made it so that GADT constructors with type-equality constraints that should have no runtime representation actually ended up impacting the code generation. Fixes #23158 - - - - - 2 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/StgToCmm/DataCon.hs Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1397,7 +1397,7 @@ dataConSourceArity (MkData { dcSourceArity = arity }) = arity -- | Gives the number of actual fields in the /representation/ of the -- data constructor. This may be more than appear in the source code; --- the extra ones are the existentially quantified dictionaries +-- the extra ones are the existentially quantified dictionaries. ROMES:TODO: dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity ===================================== compiler/GHC/StgToCmm/DataCon.hs ===================================== @@ -37,11 +37,12 @@ import GHC.Runtime.Heap.Layout import GHC.Types.CostCentre import GHC.Unit import GHC.Core.DataCon +import GHC.Core.TyCo.Rep (scaledThing) import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Id.Info( CafInfo( NoCafRefs ) ) import GHC.Types.Name (isInternalName) -import GHC.Types.RepType (countConRepArgs) +import GHC.Types.RepType (countConRepArgs, isZeroBitTy) import GHC.Types.Literal import GHC.Builtin.Utils import GHC.Utils.Panic @@ -327,9 +328,19 @@ because they don't support cross package data references well. precomputedStaticConInfo_maybe :: StgToCmmConfig -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo precomputedStaticConInfo_maybe cfg binder con [] -- Nullary constructors - | isNullaryRepDataCon con + | isStgNullaryDataCon con = Just $ litIdInfo (stgToCmmPlatform cfg) binder (mkConLFInfo con) (CmmLabel (mkClosureLabel (dataConName con) NoCafRefs)) + where + -- morally equivalent to (isNullaryRepDataCon con) at the Stg level, where we + -- doesn't consider types with no runtime representation to be constructor arguments. + -- + -- isNullaryRepDataCon is not fit for checking whether the constructor is + -- nullary at the Stg level because the function 'dataConRepArgTys' it + -- depends on includes unlifted type equalities, whose runtime + -- representation is 'VoidRep', in the returned list. + isStgNullaryDataCon = null . filter (not . isZeroBitTy . scaledThing) . dataConRepArgTys + precomputedStaticConInfo_maybe cfg binder con [arg] -- Int/Char values with existing closures in the RTS | intClosure || charClosure View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c26f67d3028874a358de9baeae2e5ba39e468fa6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c26f67d3028874a358de9baeae2e5ba39e468fa6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 22:45:54 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 22 Mar 2023 18:45:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/clc-148 Message-ID: <641b85225bfc5_90da3d2f05ac7722f5@gitlab.mail> Ryan Scott pushed new branch wip/clc-148 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/clc-148 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 23:40:08 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 22 Mar 2023 19:40:08 -0400 Subject: [Git][ghc/ghc][wip/expand-do] move expand_do_stmts GHC.Tc.Match so that we can type check patterns and... Message-ID: <641b91d8c16c7_90da3e341eb07809bc@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: a40ab2dc by Apoorv Ingle at 2023-03-22T18:39:50-05:00 move expand_do_stmts GHC.Tc.Match so that we can type check patterns and determine more accurately if we need to generate a fail block - - - - - 8 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - + testsuite/tests/rebindable/T23147.hs - testsuite/tests/rebindable/all.T - testsuite/tests/rebindable/pattern-fails.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -418,6 +418,23 @@ type instance XXExpr GhcTc = XXExprGhcTc -- HsExpansion: see Note [Rebindable syntax and HsExpansion] below + +{- ********************************************************************* +* * + Generating code for HsExpanded + See Note [Handling overloaded and rebindable constructs] +* * +********************************************************************* -} + +-- | Build a 'HsExpansion' out of an extension constructor, +-- and the two components of the expansion: original and +-- desugared expressions. +mkExpandedExpr + :: HsExpr GhcRn -- ^ source expression + -> HsExpr GhcRn -- ^ expanded expression + -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' +mkExpandedExpr a b = XExpr (HsExpanded a b) + data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions {-# UNPACK #-} !(HsWrap HsExpr) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -24,7 +24,7 @@ free variables. -} module GHC.Rename.Expr ( - rnLExpr, rnExpr, rnStmts, mkExpandedExpr, + rnLExpr, rnExpr, rnStmts, AnnoBody, UnexpectedStatement(..) ) where @@ -58,7 +58,6 @@ import GHC.Builtin.Names import GHC.Types.FieldLabel import GHC.Types.Fixity import GHC.Types.Id.Make -import GHC.Types.Basic(Origin(..)) import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Reader @@ -77,7 +76,7 @@ import qualified GHC.LanguageExtensions as LangExt import Language.Haskell.Syntax.Basic (FieldLabelString(..)) -import Data.List (unzip4, minimumBy, (\\)) +import Data.List (unzip4, minimumBy) import Data.List.NonEmpty ( NonEmpty(..), nonEmpty ) import Data.Maybe (isJust, isNothing) import Control.Arrow (first) @@ -433,24 +432,8 @@ rnExpr (HsDo _ do_or_lc (L l stmts)) = do { ((stmts1, _), fvs1) <- rnStmtsWithFreeVars (HsDoStmt do_or_lc) rnExpr stmts (\ _ -> return ((), emptyFVs)) - ; ((pp_stmts, fvs2), is_app_do) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 - ; let orig_do_block = HsDo noExtField do_or_lc (L l pp_stmts) - ; return $ case do_or_lc of - DoExpr {} -> (if is_app_do - -- TODO i don't want to thing about applicative stmt rearrangements yet - then orig_do_block - else let expd_do_block = expand_do_stmts do_or_lc pp_stmts - in mkExpandedExpr orig_do_block expd_do_block - , fvs1 `plusFV` fvs2 ) - MDoExpr {} -> (if is_app_do - -- TODO i don't want to thing about applicative stmt rearrangements yet - then orig_do_block - else let expd_do_block = expand_do_stmts do_or_lc pp_stmts - in mkExpandedExpr orig_do_block expd_do_block - , fvs1 `plusFV` fvs2 ) - _ -> (orig_do_block, fvs1 `plusFV` fvs2) - -- ListComp -> (orig_do_block, fvs1 `plusFV` fvs2) - -- GhciStmtCtxt -> (orig_do_block, fvs1 `plusFV` fvs2) + ; (pp_stmts, fvs2) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 + ; return (HsDo noExtField do_or_lc (L l pp_stmts), fvs1 `plusFV` fvs2) } -- ExplicitList: see Note [Handling overloaded and rebindable constructs] rnExpr (ExplicitList _ exps) @@ -1074,7 +1057,7 @@ rnStmts ctxt rnBody stmts thing_inside postProcessStmtsForApplicativeDo :: HsDoFlavour -> [(ExprLStmt GhcRn, FreeVars)] - -> RnM (([ExprLStmt GhcRn], FreeVars), Bool) -- True <=> applicative do statement + -> RnM ([ExprLStmt GhcRn], FreeVars) postProcessStmtsForApplicativeDo ctxt stmts = do { -- rearrange the statements using ApplicativeStmt if @@ -1089,9 +1072,9 @@ postProcessStmtsForApplicativeDo ctxt stmts ; if ado_is_on && is_do_expr && not in_th_bracket then do { traceRn "ppsfa" (ppr stmts) ; ado_stmts_and_fvs <- rearrangeForApplicativeDo ctxt stmts - ; return (ado_stmts_and_fvs, True) } + ; return ado_stmts_and_fvs } else do { do_stmts_and_fvs <- noPostProcessStmts (HsDoStmt ctxt) stmts - ; return (do_stmts_and_fvs, False) } } + ; return do_stmts_and_fvs } } -- | strip the FreeVars annotations from statements noPostProcessStmts @@ -2713,158 +2696,6 @@ getMonadFailOp ctxt * * ********************************************************************* -} --- | Build a 'HsExpansion' out of an extension constructor, --- and the two components of the expansion: original and --- desugared expressions. -mkExpandedExpr - :: HsExpr GhcRn -- ^ source expression - -> HsExpr GhcRn -- ^ expanded expression - -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' -mkExpandedExpr a b = XExpr (HsExpanded a b) - - - --- | Expand the Do statments so that it works fine with Quicklook --- See Note[Rebindable Do Expanding Statements] --- ANI Questions: 1. What should be the location information in the expanded expression? Currently the error is displayed on the expanded expr and not on the unexpanded expr -expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> HsExpr GhcRn - -expand_do_stmts do_flavour [L _ (LastStmt _ body _ NoSyntaxExprRn)] - -- if it is a last statement of a list comprehension, we need to explicitly return it -- See Note [TODO] - -- genHsApp (genHsVar returnMName) body - | ListComp <- do_flavour - = genHsApp (genHsVar returnMName) body - | MonadComp <- do_flavour - = unLoc body -- genHsApp (genHsVar returnMName) body - | otherwise - -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt - = unLoc body - -expand_do_stmts _ [L _ (LastStmt _ body _ (SyntaxExprRn ret))] --- --- ------------------------------------------------ --- return e ~~> return e --- definitely works T18324.hs - = unLoc $ mkHsApp (noLocA ret) body - -expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn x e)): lstmts) - | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn - , Just (SyntaxExprRn fail_op) <- xbsrn_failOp xbsrn = --- the pattern binding x can fail --- stmts ~~> stmt' let f x = stmts'; f _ = fail ".." --- ------------------------------------------------------- --- x <- e ; stmts ~~> (Prelude.>>=) e f - - foldl genHsApp bind_op -- (>>=) - [ e - , noLocA $ failable_expr x (expand_do_stmts do_or_lc lstmts) fail_op - ] - | SyntaxExprRn bop <- xbsrn_bindOp xbsrn - , Nothing <- xbsrn_failOp xbsrn = -- irrefutable pattern so no failure --- stmts ~~> stmt' --- ------------------------------------------------ --- x <- e ; stmts ~~> (Prelude.>>=) e (\ x -> stmts') - foldl genHsApp bop -- (>>=) - [ e - , mkHsLam [x] (noLocA $ expand_do_stmts do_or_lc lstmts) -- (\ x -> stmts') - ] - - | otherwise = -- just use the polymorhpic bindop. TODO: Necessary? - genHsApps bindMName -- (Prelude.>>=) - [ e - , mkHsLam [x] (noLocA $ expand_do_stmts do_or_lc lstmts) -- (\ x -> stmts') - ] - - where - failable_expr :: LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn - failable_expr pat expr fail_op = HsLam noExtField $ - mkMatchGroup Generated - (noLocA [ mkHsCaseAlt pat (noLocA expr) - , mkHsCaseAlt nlWildPatName - (noLocA $ genHsApp fail_op - (nlHsLit $ mkHsString "fail pattern")) ]) - -expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = --- stmts ~~> stmts' --- ------------------------------------------------ --- let x = e ; stmts ~~> let x = e in stmts' - HsLet NoExtField noHsTok bnds noHsTok - $ noLocA (expand_do_stmts do_or_lc lstmts) - - -expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = --- stmts ~~> stmts' --- ---------------------------------------------- --- e ; stmts ~~> (Prelude.>>) e stmt' - unLoc $ nlHsApp (nlHsApp (noLocA f) -- (>>) See Note [BodyStmt] - e) - $ (noLocA $ expand_do_stmts do_or_lc lstmts) - -expand_do_stmts do_or_lc ((L l (RecStmt { recS_stmts = rec_stmts - , recS_later_ids = later_ids -- forward referenced local ids - , recS_rec_ids = local_ids -- ids referenced outside of the rec block - , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr - , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr - -- use it explicitly - -- at the end of expanded rec block - })) - : lstmts) = --- See Note [Typing a RecStmt] --- stmts ~~> stmts' --- ------------------------------------------------------------------------------------------- --- rec { later_ids, local_ids, rec_block } ; stmts --- ~~> (Prelude.>>=) (mfix (\[ local_ids ++ later_ids ] --- -> do { rec_stmts --- ; return (later_ids, local_ids) } )) --- (\ [ local_ids ++ later_ids ] -> stmts') - - genHsApps bindMName -- (Prelude.>>=) - [ (noLocA mfix_fun) `mkHsApp` mfix_expr -- mfix (do block) - , mkHsLam [ mkBigLHsVarPatTup all_ids ] -- (\ x -> stmts') - (L l $ expand_do_stmts do_or_lc lstmts) - ] - where - local_only_ids = local_ids \\ later_ids -- get unique local rec ids; local rec ids and later ids overlap - all_ids = local_only_ids ++ later_ids -- put local ids before return ids - - return_stmt :: ExprLStmt GhcRn - return_stmt = noLocA $ LastStmt noExtField - (mkHsApp (noLocA return_fun) - $ mkBigLHsTup (map nlHsVar all_ids) noExtField) - Nothing - (SyntaxExprRn return_fun) - do_stmts :: XRec GhcRn [ExprLStmt GhcRn] - do_stmts = noLocA $ (unLoc rec_stmts) ++ [return_stmt] - do_block :: LHsExpr GhcRn - do_block = noLocA $ HsDo noExtField (DoExpr Nothing) $ do_stmts - mfix_expr :: LHsExpr GhcRn - mfix_expr = mkHsLam [ mkBigLHsVarPatTup all_ids ] $ do_block - -expand_do_stmts _ (stmt@(L _ (RecStmt {})):_) = - pprPanic "expand_do_stmts: impossible happened RecStmt" $ ppr stmt - - -expand_do_stmts _ (stmt@(L _ (TransStmt {})):_) = - pprPanic "expand_do_stmts: impossible happened TransStmt" $ ppr stmt - -expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = --- See See Note [Monad Comprehensions] --- Parallel statements only appear in --- stmts ~~> stmts' --- ------------------------------------------------------------------------------------------- --- ; stmts --- ~~> (Prelude.>>=) (mfix (\[ local_ids ++ later_ids ] --- -> do { rec_stmts --- ; return (later_ids, local_ids) } )) --- (\ [ local_ids ++ later_ids ] -> stmts') - pprPanic "expand_do_stmts: impossible happened ParStmt" $ ppr stmt - -expand_do_stmts _ (stmt@(L _ (ApplicativeStmt {})):_) = --- See Note [Applicative BodyStmt] - - pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" $ ppr stmt - -expand_do_stmts do_flavor stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr do_flavor $$ ppr stmts) ----------------------------------------- -- Bits and pieces for RecordDotSyntax. ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -49,7 +49,6 @@ import GHC.Tc.Gen.Head import GHC.Tc.Gen.Bind ( tcLocalBinds ) import GHC.Tc.Instance.Family ( tcGetFamInstEnvs ) import GHC.Core.FamInstEnv ( FamInstEnvs ) -import GHC.Rename.Expr ( mkExpandedExpr ) import GHC.Rename.Env ( addUsedGRE ) import GHC.Tc.Utils.Env import GHC.Tc.Gen.Arrow ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -42,7 +42,7 @@ import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRho, tcInferRhoNC , tcCheckMonoExpr, tcCheckMonoExprNC , tcCheckPolyExpr ) -import GHC.Rename.Utils ( bindLocalNames ) +import GHC.Rename.Utils ( bindLocalNames, genHsApp, genHsApps, genHsVar ) import GHC.Tc.Errors.Types import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env @@ -66,6 +66,7 @@ import GHC.Hs import GHC.Builtin.Types import GHC.Builtin.Types.Prim +import GHC.Builtin.Names (bindMName, returnMName) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -76,11 +77,12 @@ import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name import GHC.Types.Id import GHC.Types.SrcLoc +import GHC.Types.Basic (Origin (..)) import Control.Monad import Control.Arrow ( second ) import qualified Data.List.NonEmpty as NE - +import Data.List ((\\)) {- ************************************************************************ * * @@ -316,14 +318,29 @@ tcDoStmts ListComp (L l stmts) res_ty ; return $ mkHsWrapCo co (HsDo list_ty ListComp (L l stmts')) } tcDoStmts doExpr@(DoExpr _) (L l stmts) res_ty - = do { stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty - ; res_ty <- readExpType res_ty - ; return (HsDo res_ty doExpr (L l stmts')) } + = do { -- stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty + -- ; res_ty <- readExpType res_ty + -- ; return (HsDo res_ty doExpr (L l stmts')) + expand_expr <- expand_do_stmts doExpr stmts + ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doExpr (L l stmts)) + (unLoc expand_expr) + -- Do expansion on the fly + ; traceTc "tcDoStmts" (text "tcExpr:" <+> ppr expand_do_expr) + ; tcExpr expand_do_expr res_ty + } tcDoStmts mDoExpr@(MDoExpr _) (L l stmts) res_ty - = do { stmts' <- tcStmts (HsDoStmt mDoExpr) tcDoStmt stmts res_ty - ; res_ty <- readExpType res_ty - ; return (HsDo res_ty mDoExpr (L l stmts')) } + = do { -- stmts' <- tcStmts (HsDoStmt mDoExpr) tcDoStmt stmts res_ty + -- ; res_ty <- readExpType res_ty + -- ; return (HsDo res_ty mDoExpr (L l stmts')) + expand_expr <- expand_do_stmts mDoExpr stmts + ; let expand_do_expr = mkExpandedExpr (HsDo noExtField mDoExpr (L l stmts)) + (unLoc expand_expr) + -- Do expansion on the fly + ; traceTc "tcDoStmts" (text "tcExpr:" <+> ppr expand_do_expr) + ; tcExpr expand_do_expr res_ty + + } tcDoStmts MonadComp (L l stmts) res_ty = do { stmts' <- tcStmts (HsDoStmt MonadComp) tcMcStmt stmts res_ty @@ -857,7 +874,7 @@ tcDoStmt _ (LastStmt x body noret _) res_ty thing_inside = do { body' <- tcMonoExprNC body res_ty ; thing <- thing_inside (panic "tcDoStmt: thing_inside") ; return (LastStmt x body' noret noSyntaxExpr, thing) } - +-- ANI TODO: This is really needed? tcDoStmt ctxt (BindStmt xbsrn pat rhs) res_ty thing_inside = do { -- Deal with rebindable syntax: -- (>>=) :: rhs_ty ->_rhs_mult (pat_ty ->_pat_mult new_res_ty) ->_fun_mult res_ty @@ -896,7 +913,7 @@ tcDoStmt ctxt (ApplicativeStmt _ pairs mb_join) res_ty thing_inside \ [rhs_ty] [rhs_mult] -> tcScalingUsage rhs_mult $ tc_app_stmts (mkCheckExpType rhs_ty)) ; return (ApplicativeStmt body_ty pairs' mb_join', thing) } - +-- ANI TODO: can we get rid of this? tcDoStmt _ (BodyStmt _ rhs then_op _) res_ty thing_inside = do { -- Deal with rebindable syntax; -- (>>) :: rhs_ty -> new_res_ty -> res_ty @@ -909,7 +926,7 @@ tcDoStmt _ (BodyStmt _ rhs then_op _) res_ty thing_inside ; hasFixedRuntimeRep_syntactic (FRRBodyStmt DoNotation 1) rhs_ty ; hasFixedRuntimeRep_syntactic (FRRBodyStmt DoNotation 2) new_res_ty ; return (BodyStmt rhs_ty rhs' then_op' noSyntaxExpr, thing) } - +-- ANI TODO: Is this really needed? tcDoStmt ctxt (RecStmt { recS_stmts = L l stmts, recS_later_ids = later_names , recS_rec_ids = rec_names, recS_ret_fn = ret_op , recS_mfix_fn = mfix_op, recS_bind_fn = bind_op }) @@ -1172,3 +1189,168 @@ checkArgCounts matchContext (MG { mg_alts = L _ (match1:matches) }) args_in_match :: (LocatedA (Match GhcRn body1) -> Int) args_in_match (L _ (Match { m_pats = pats })) = length pats + +{- +************************************************************************ +* * +\subsection{HsExpansion for Do Statements} +* * +************************************************************************ +-} +-- | Expand the Do statments so that it works fine with Quicklook +-- See Note[Rebindable Do and Expanding Statements] +-- ANI Questions: 1. What should be the location information in the expanded expression? Currently the error is displayed on the expanded expr and not on the unexpanded expr +expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) + +expand_do_stmts do_flavour [L _ (LastStmt _ body _ ret_expr)] + -- last statement of a list comprehension, needs to explicitly return it + -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` + -- TODO: i don't think we need this if we never call from a ListComp + | ListComp <- do_flavour + = return $ noLocA (genHsApp (genHsVar returnMName) body) + | NoSyntaxExprRn <- ret_expr + -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt + = return body + | SyntaxExprRn ret <- ret_expr + -- + -- ------------------------------------------------ + -- return e ~~> return e + -- to make T18324 work + = return $ mkHsApp (noLocA ret) body + + +expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) + | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn + , Just (SyntaxExprRn fail_op) <- xbsrn_failOp xbsrn = +-- the pattern binding x can fail +-- stmts ~~> stmt' let f pat = stmts'; f _ = fail ".." +-- ------------------------------------------------------- +-- pat <- e ; stmts ~~> (Prelude.>>=) e f + do expand_stmts <- expand_do_stmts do_or_lc lstmts + expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op + return $ noLocA (foldl genHsApp bind_op -- (>>=) + [ e + , expr + ]) + + | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn + , Nothing <- xbsrn_failOp xbsrn = -- irrefutable pattern so no failure +-- stmts ~~> stmt' +-- ------------------------------------------------ +-- x <- e ; stmts ~~> (Prelude.>>=) e (\ x -> stmts') + do expand_stmts <- expand_do_stmts do_or_lc lstmts + return $ noLocA (foldl genHsApp bind_op -- (>>=) + [ e + , mkHsLam [pat] expand_stmts -- (\ x -> stmts') + ]) + + | otherwise = -- just use the polymorhpic bindop. TODO: Necessary? + do expand_stmts <- expand_do_stmts do_or_lc lstmts + return $ noLocA (genHsApps bindMName -- (Prelude.>>=) + [ e + , mkHsLam [pat] expand_stmts -- (\ x -> stmts') + ]) + + where + mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn -> TcM (LHsExpr GhcRn) + -- checks the pattern pat and decides if we need to plug in the fail block + -- Type checking the pattern is necessary to decide if we need to generate the fail block + -- Renamer cannot always determine if a fail block is necessary, and its conservative behaviour would + -- generate a fail block even if it is not really needed. cf. GHC.Hs.isIrrefutableHsPat + -- Only Tuples are considered irrefutable in the renamer, while newtypes and TyCons with only one datacon + -- is not + mk_failable_lexpr_tcm pat lexpr fail_op = + do { ((tc_pat, _), _) <- tcInferPat (FRRBindStmt DoNotation) + PatBindRhs pat $ return id -- whatever + ; dflags <- getDynFlags + ; if isIrrefutableHsPat dflags tc_pat + then return $ mkHsLam [pat] lexpr + else return $ mk_fail_lexpr pat lexpr fail_op + } + mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn -> LHsExpr GhcRn + -- makes the fail block + -- TODO: check the discussion around MonadFail.fail type signature. + -- Should we really say `mkHsString "fail pattern"`? if yes, maybe a better error message would help + mk_fail_lexpr pat lexpr fail_op = + noLocA (HsLam noExtField $ mkMatchGroup Generated -- let + (noLocA [ mkHsCaseAlt pat lexpr -- f pat = expr + , mkHsCaseAlt nlWildPatName -- f _ = fail "fail pattern" + (noLocA $ genHsApp fail_op + (nlHsLit $ mkHsString "fail pattern")) ])) + +expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = +-- stmts ~~> stmts' +-- ------------------------------------------------ +-- let x = e ; stmts ~~> let x = e in stmts' + do expand_stmts <- expand_do_stmts do_or_lc lstmts + return $ noLocA (HsLet noExtField noHsTok bnds noHsTok (expand_stmts)) + + +expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = +-- See Note [BodyStmt] +-- stmts ~~> stmts' +-- ---------------------------------------------- +-- e ; stmts ~~> (>>) e stmts' + do expand_stmts <- expand_do_stmts do_or_lc lstmts + return $ mkHsApps (noLocA f) -- (>>) + [ e -- e + , expand_stmts ] -- stmts' + +expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts + , recS_later_ids = later_ids -- forward referenced local ids + , recS_rec_ids = local_ids -- ids referenced outside of the rec block + , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr + , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr + -- use it explicitly + -- at the end of expanded rec block + })) + : lstmts) = +-- See Note [Typing a RecStmt] +-- stmts ~~> stmts' +-- ------------------------------------------------------------------------------------------- +-- rec { later_ids, local_ids, rec_block } ; stmts +-- ~~> (>>=) (mfix (\[ local_only_ids ++ later_ids ] +-- -> do { rec_stmts +-- ; return (local_only_ids ++ later_ids) } )) +-- (\ [ local_only_ids ++ later_ids ] -> stmts') + do expand_stmts <- expand_do_stmts do_or_lc lstmts + return $ noLocA (genHsApps bindMName -- (Prelude.>>=) + [ (noLocA mfix_fun) `mkHsApp` mfix_expr -- (mfix (do block)) + , mkHsLam [ mkBigLHsVarPatTup all_ids ] -- (\ x -> + expand_stmts -- stmts') + ]) + where + local_only_ids = local_ids \\ later_ids -- get unique local rec ids; local rec ids and later ids overlap + all_ids = local_only_ids ++ later_ids -- put local ids before return ids + + return_stmt :: ExprLStmt GhcRn + return_stmt = noLocA $ LastStmt noExtField + (mkHsApp (noLocA return_fun) + $ mkBigLHsTup (map nlHsVar all_ids) noExtField) + Nothing + (SyntaxExprRn return_fun) + do_stmts :: XRec GhcRn [ExprLStmt GhcRn] + do_stmts = noLocA $ (unLoc rec_stmts) ++ [return_stmt] + do_block :: LHsExpr GhcRn + do_block = noLocA $ HsDo noExtField (DoExpr Nothing) $ do_stmts + mfix_expr :: LHsExpr GhcRn + mfix_expr = mkHsLam [ mkBigLHsVarPatTup all_ids ] $ do_block + +expand_do_stmts _ (stmt@(L _ (ApplicativeStmt _ appargs (Just join))):_) = +-- See Note [Applicative BodyStmt] + pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" $ ppr stmt + +expand_do_stmts _ (stmt@(L _ (ApplicativeStmt _ appargs Nothing)):_) = +-- See Note [Applicative BodyStmt] + pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" $ ppr stmt + +expand_do_stmts _ (stmt@(L _ (TransStmt {})):_) = + pprPanic "expand_do_stmts: impossible happened TransStmt" $ ppr stmt + +expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = +-- See See Note [Monad Comprehensions] + + pprPanic "expand_do_stmts: impossible happened ParStmt" $ ppr stmt + + +expand_do_stmts do_flavor stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr do_flavor $$ ppr stmts) ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -104,7 +104,7 @@ tcLetPat sig_fn no_gen pat pat_ty thing_inside ----------------- tcPats :: HsMatchContext GhcTc - -> [LPat GhcRn] -- ^ atterns + -> [LPat GhcRn] -- ^ patterns -> [Scaled ExpSigmaTypeFRR] -- ^ types of the patterns -> TcM a -- ^ checker for the body -> TcM ([LPat GhcTc], a) ===================================== testsuite/tests/rebindable/T23147.hs ===================================== @@ -0,0 +1,27 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE QualifiedDo #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE GADTs #-} + +module T23147 where + +import qualified Control.Monad as M +import Prelude hiding (return, (>>=)) + +type Exis f = (forall r. (forall t. f t -> r) -> r) + +data Indexed t where + Indexed :: Indexed Int + +(>>=) :: Monad m => m (Exis f) -> (forall t. f t -> m (Exis g)) -> m (Exis g) +x >>= f = x M.>>= (\x' -> x' f) + +return :: Monad m => Exis f -> m (Exis f) +return = M.return + +test :: (Monad m) => Exis Indexed -> m (Exis Indexed) +test x = + T23147.do + (reified :: Indexed t) <- return x + return (\g -> g reified) ===================================== testsuite/tests/rebindable/all.T ===================================== @@ -42,5 +42,7 @@ test('T14670', expect_broken(14670), compile, ['']) test('T19167', normal, compile, ['']) test('T19918', normal, compile_and_run, ['']) test('T20126', normal, compile_fail, ['']) -test('T18324', normal, compile_and_run, ['']) -test('pattern-fails', normal, compile_and_run, ['']) +# Tests for desugaring do before typechecking +test('T18324', normal, compile, ['']) +test('T23147', normal, compile, ['']) +test('pattern-fails', normal, compile, ['']) ===================================== testsuite/tests/rebindable/pattern-fails.hs ===================================== @@ -1,9 +1,18 @@ -module Main where +module PF where -main :: IO () -main = putStrLn . show $ qqq ['c'] +-- main :: IO () +-- main = putStrLn . show $ qqq ['c'] qqq :: [a] -> Maybe (a, [a]) qqq ts = do { (a:b:as) <- Just ts ; return (a, as) } + +newtype ST a b = ST (a, b) + +emptyST :: Maybe (ST Int Int) +emptyST = Just $ ST (0, 0) + +ppp :: Maybe (ST Int Int) -> Maybe (ST Int Int) +ppp st = do { ST (x, y) <- st + ; return $ ST (x+1, y+1)} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a40ab2dc5b88d37b9b2deee5e657c83a03d6d2c8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a40ab2dc5b88d37b9b2deee5e657c83a03d6d2c8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 22 23:40:51 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 22 Mar 2023 19:40:51 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 22 commits: ghci: only keep the GlobalRdrEnv in ModInfo Message-ID: <641b9203c2e6e_90da3e5f19587815ee@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - f40f1a6d by Apoorv Ingle at 2023-03-22T18:40:37-05:00 HsExpand for HsDo Fixes for #18324 - fixed rec do blocks to use mfix - make sure fail is used for pattern match failures in bind statments - - - - - 2056d676 by Apoorv Ingle at 2023-03-22T18:40:37-05:00 move expand_do_stmts GHC.Tc.Match so that we can type check patterns and determine more accurately if we need to generate a fail block - - - - - 29 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a40ab2dc5b88d37b9b2deee5e657c83a03d6d2c8...2056d676f90722fd4d75bd314a3d531d84544916 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a40ab2dc5b88d37b9b2deee5e657c83a03d6d2c8...2056d676f90722fd4d75bd314a3d531d84544916 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 00:32:27 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 22 Mar 2023 20:32:27 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 26 commits: Fix BCO creation setting caps when -j > -N Message-ID: <641b9e1b938e8_90da3f23f868784096@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - f6e2c5d2 by Ben Gamari at 2023-03-22T20:30:15-04:00 testsuite: Add test for atomicSwapIORef - - - - - 818f61be by Ben Gamari at 2023-03-22T20:30:17-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - 2badf6d8 by Ben Gamari at 2023-03-22T20:32:02-04:00 Make atomicSwapMutVar# an inline primop - - - - - 29 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ecbf7a2672d72182c552c9ba9ffb45be68080af...2badf6d86a12c71702c42e7ac04805fec2414957 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ecbf7a2672d72182c552c9ba9ffb45be68080af...2badf6d86a12c71702c42e7ac04805fec2414957 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 02:15:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 22 Mar 2023 22:15:45 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] Make atomicSwapMutVar# an inline primop Message-ID: <641bb65172073_90da40d296107894a7@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: e6ba99fb by Ben Gamari at 2023-03-22T22:15:38-04:00 Make atomicSwapMutVar# an inline primop - - - - - 5 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/include/stg/MiscClosures.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2517,7 +2517,6 @@ primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp MutVar# s v -> v -> State# s -> (# State# s, v #) {Atomically exchange the value of a 'MutVar#'.} with - out_of_line = True has_side_effects = True -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -308,6 +308,10 @@ emitPrimOp cfg primop = (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutv)) mkdirtyMutVarCCall + AtomicSwapMutVarOp -> \[mutv, val] -> opIntoRegs $ \[res] -> do + let dst = cmmOffsetW platform mutv (fixedHdrSizeW profile) + emitAssign (CmmLocal res) (MO_Xchg (wordWidth platform)) [dst, val] + -- #define sizzeofByteArrayzh(r,a) \ -- r = ((StgArrBytes *)(a))->bytes SizeofByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> @@ -1559,7 +1563,6 @@ emitPrimOp cfg primop = ResizeMutableByteArrayOp_Char -> alwaysExternal ShrinkSmallMutableArrayOp_Char -> alwaysExternal NewMutVarOp -> alwaysExternal - AtomicSwapMutVarOp -> alwaysExternal AtomicModifyMutVar2Op -> alwaysExternal AtomicModifyMutVar_Op -> alwaysExternal CasMutVarOp -> alwaysExternal ===================================== rts/PrimOps.cmm ===================================== @@ -689,14 +689,6 @@ stg_newMutVarzh ( gcptr init ) return (mv); } -stg_atomicSwapMutVarzh ( gcptr mv, gcptr old ) - /* MutVar# s a -> a -> State# s -> (# State#, a #) */ -{ - W_ new; - (new) = prim %xchgW(mv+OFFSET_StgMutVar_var, old); - return (new); -} - // RRN: To support the "ticketed" approach, we return the NEW rather // than old value if the CAS is successful. This is received in an // opaque form in the Haskell code, preventing the compiler from ===================================== rts/RtsSymbols.c ===================================== @@ -633,7 +633,6 @@ extern char **environ; SymI_HasDataProto(stg_writeIOPortzh) \ SymI_HasDataProto(stg_newIOPortzh) \ SymI_HasDataProto(stg_noDuplicatezh) \ - SymI_HasDataProto(stg_atomicSwapMutVarzh) \ SymI_HasDataProto(stg_atomicModifyMutVar2zh) \ SymI_HasDataProto(stg_atomicModifyMutVarzuzh) \ SymI_HasDataProto(stg_casMutVarzh) \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -481,7 +481,6 @@ RTS_FUN_DECL(stg_copySmallMutableArrayzh); RTS_FUN_DECL(stg_casSmallArrayzh); RTS_FUN_DECL(stg_newMutVarzh); -RTS_FUN_DECL(stg_atomicSwapMutVarzh); RTS_FUN_DECL(stg_atomicModifyMutVar2zh); RTS_FUN_DECL(stg_atomicModifyMutVarzuzh); RTS_FUN_DECL(stg_casMutVarzh); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6ba99fb878a10f12cd8b8d55a34a9cd1f599f1e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6ba99fb878a10f12cd8b8d55a34a9cd1f599f1e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 02:23:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 22 Mar 2023 22:23:03 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] Make atomicSwapMutVar# an inline primop Message-ID: <641bb807dce81_90da40ff757c7920af@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: 373f22f7 by Ben Gamari at 2023-03-22T22:22:54-04:00 Make atomicSwapMutVar# an inline primop - - - - - 5 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/include/stg/MiscClosures.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2517,7 +2517,6 @@ primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp MutVar# s v -> v -> State# s -> (# State# s, v #) {Atomically exchange the value of a 'MutVar#'.} with - out_of_line = True has_side_effects = True -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -308,6 +308,10 @@ emitPrimOp cfg primop = (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutv)) mkdirtyMutVarCCall + AtomicSwapMutVarOp -> \[mutv, val] -> opIntoRegs $ \[res] -> do + let dst = cmmOffsetW platform mutv (fixedHdrSizeW profile) + emitPrimCall [res] (MO_Xchg (wordWidth platform)) [dst, val] + -- #define sizzeofByteArrayzh(r,a) \ -- r = ((StgArrBytes *)(a))->bytes SizeofByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> @@ -1559,7 +1563,6 @@ emitPrimOp cfg primop = ResizeMutableByteArrayOp_Char -> alwaysExternal ShrinkSmallMutableArrayOp_Char -> alwaysExternal NewMutVarOp -> alwaysExternal - AtomicSwapMutVarOp -> alwaysExternal AtomicModifyMutVar2Op -> alwaysExternal AtomicModifyMutVar_Op -> alwaysExternal CasMutVarOp -> alwaysExternal ===================================== rts/PrimOps.cmm ===================================== @@ -689,14 +689,6 @@ stg_newMutVarzh ( gcptr init ) return (mv); } -stg_atomicSwapMutVarzh ( gcptr mv, gcptr old ) - /* MutVar# s a -> a -> State# s -> (# State#, a #) */ -{ - W_ new; - (new) = prim %xchgW(mv+OFFSET_StgMutVar_var, old); - return (new); -} - // RRN: To support the "ticketed" approach, we return the NEW rather // than old value if the CAS is successful. This is received in an // opaque form in the Haskell code, preventing the compiler from ===================================== rts/RtsSymbols.c ===================================== @@ -633,7 +633,6 @@ extern char **environ; SymI_HasDataProto(stg_writeIOPortzh) \ SymI_HasDataProto(stg_newIOPortzh) \ SymI_HasDataProto(stg_noDuplicatezh) \ - SymI_HasDataProto(stg_atomicSwapMutVarzh) \ SymI_HasDataProto(stg_atomicModifyMutVar2zh) \ SymI_HasDataProto(stg_atomicModifyMutVarzuzh) \ SymI_HasDataProto(stg_casMutVarzh) \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -481,7 +481,6 @@ RTS_FUN_DECL(stg_copySmallMutableArrayzh); RTS_FUN_DECL(stg_casSmallArrayzh); RTS_FUN_DECL(stg_newMutVarzh); -RTS_FUN_DECL(stg_atomicSwapMutVarzh); RTS_FUN_DECL(stg_atomicModifyMutVar2zh); RTS_FUN_DECL(stg_atomicModifyMutVarzuzh); RTS_FUN_DECL(stg_casMutVarzh); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/373f22f7e8813caf26556d51978aac2669b4aaf1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/373f22f7e8813caf26556d51978aac2669b4aaf1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 02:30:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 22 Mar 2023 22:30:25 -0400 Subject: [Git][ghc/ghc][wip/T23146] testsuite: Add test for #23146 Message-ID: <641bb9c128d5a_90da412ae784792999@gitlab.mail> Ben Gamari pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: 3d53be90 by Ben Gamari at 2023-03-22T22:30:05-04:00 testsuite: Add test for #23146 - - - - - 4 changed files: - + testsuite/tests/codeGen/should_run/T23146.hs - + testsuite/tests/codeGen/should_run/T23146.stdout - + testsuite/tests/codeGen/should_run/T23146A.hs - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== testsuite/tests/codeGen/should_run/T23146.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs #-} + +import T23146A + +fieldsSam :: NP xs -> NP xs -> Bool +fieldsSam (x' ::* xs) (y' ::* ys) = fieldsSam xs ys +fieldsSam UNil UNil = True + +main :: IO () +main = print (fieldsSam UNil UNil) + ===================================== testsuite/tests/codeGen/should_run/T23146.stdout ===================================== @@ -0,0 +1,2 @@ +True + ===================================== testsuite/tests/codeGen/should_run/T23146A.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE UnliftedDatatypes #-} +module B where + +import GHC.Exts + +type NP :: [UnliftedType] -> UnliftedType +data NP xs where + UNil :: NP '[] + (::*) :: x -> NP xs -> NP (x ': xs) + ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,3 +229,4 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) +test('T23146', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d53be9081b7c5e248c003e0baf5e006ec559165 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d53be9081b7c5e248c003e0baf5e006ec559165 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 08:45:11 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 23 Mar 2023 04:45:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23159 Message-ID: <641c11978acbe_90da470bbe8082258d@gitlab.mail> Simon Peyton Jones pushed new branch wip/T23159 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23159 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 08:51:24 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Thu, 23 Mar 2023 04:51:24 -0400 Subject: [Git][ghc/ghc][wip/amg/warning-categories] 2 commits: Allow WARNING pragmas to be controlled with custom categories Message-ID: <641c130c20399_90da4715434c826444@gitlab.mail> Adam Gundry pushed to branch wip/amg/warning-categories at Glasgow Haskell Compiler / GHC Commits: 6928d7c2 by Adam Gundry at 2023-03-23T08:51:13+00:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 07e0a5ca by Adam Gundry at 2023-03-23T08:51:13+00:00 Move mention of warning groups change to 9.8.1 release notes - - - - - 30 changed files: - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/using-warnings.rst - testsuite/tests/parser/should_compile/T3303.stderr - testsuite/tests/rename/should_compile/T5867.stderr - testsuite/tests/rename/should_compile/rn050.stderr - testsuite/tests/rename/should_compile/rn066.stderr - testsuite/tests/rename/should_fail/T5281.stderr - testsuite/tests/warnings/should_compile/DeprU.stderr - + testsuite/tests/warnings/should_fail/WarningCategory1.hs - + testsuite/tests/warnings/should_fail/WarningCategory1.stderr - + testsuite/tests/warnings/should_fail/WarningCategory1_B.hs - + testsuite/tests/warnings/should_fail/WarningCategory2.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e751ae58e5ee71ccef3c411fb50c91e5bd90eca...07e0a5cadb9daad97815ba587b7a105925c978fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e751ae58e5ee71ccef3c411fb50c91e5bd90eca...07e0a5cadb9daad97815ba587b7a105925c978fc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 10:09:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 23 Mar 2023 06:09:27 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Add structured error messages for GHC.Tc.Utils.TcMType Message-ID: <641c255741c1e_90da48647d94835115@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 19177aa6 by Armando Ramirez at 2023-03-23T06:09:10-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - 72eb9d62 by Armando Ramirez at 2023-03-23T06:09:10-04:00 Additional optimized versions - - - - - 757c0aa6 by Bodigrim at 2023-03-23T06:09:10-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - ae5d118a by Bodigrim at 2023-03-23T06:09:10-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - b15ff2af by Torsten Schmits at 2023-03-23T06:09:22-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Error/Codes.hs - libraries/base/Data/Functor/Compose.hs - libraries/base/changelog.md - testsuite/tests/dependent/should_fail/T11334b.stderr - testsuite/tests/dependent/should_fail/T14880-2.stderr - testsuite/tests/dependent/should_fail/T14880.stderr - testsuite/tests/dependent/should_fail/T15076.stderr - testsuite/tests/dependent/should_fail/T15076b.stderr - testsuite/tests/dependent/should_fail/T15825.stderr - testsuite/tests/patsyn/should_fail/T14112.stderr - testsuite/tests/patsyn/should_fail/T14507.stderr - testsuite/tests/patsyn/should_fail/T14552.stderr - testsuite/tests/patsyn/should_fail/T21479.stderr - testsuite/tests/patsyn/should_fail/unidir.stderr - testsuite/tests/polykinds/T15795.stderr - testsuite/tests/polykinds/T15795a.stderr - testsuite/tests/rts/linker/all.T - testsuite/tests/typecheck/no_skolem_info/T14040A.stderr - + testsuite/tests/typecheck/should_fail/PatSynArity.hs - + testsuite/tests/typecheck/should_fail/PatSynArity.stderr - + testsuite/tests/typecheck/should_fail/PatSynExistential.hs - + testsuite/tests/typecheck/should_fail/PatSynExistential.stderr - + testsuite/tests/typecheck/should_fail/PatSynUnboundVar.hs - + testsuite/tests/typecheck/should_fail/PatSynUnboundVar.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42a9733555c72f57194e230586f13522075724ad...b15ff2af14e006447a5afb5c101b4fafc60548e3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42a9733555c72f57194e230586f13522075724ad...b15ff2af14e006447a5afb5c101b4fafc60548e3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 10:10:29 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 23 Mar 2023 06:10:29 -0400 Subject: [Git][ghc/ghc][wip/jsem] Implement -jsem: parallelism controlled by semaphores Message-ID: <641c259524873_90da48647d6c84056b@gitlab.mail> Matthew Pickering pushed to branch wip/jsem at Glasgow Haskell Compiler / GHC Commits: 51290f4b by sheaf at 2023-03-23T10:08:16+00:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 13 changed files: - .gitmodules - cabal.project-reinstall - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/ghc.cabal.in - docs/users_guide/using.rst - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - + libraries/semaphore-compat - packages Changes: ===================================== .gitmodules ===================================== @@ -83,6 +83,10 @@ url = https://gitlab.haskell.org/ghc/packages/unix.git ignore = untracked branch = 2.7 +[submodule "libraries/semaphore-compat"] + path = libraries/semaphore-compat + url = https://gitlab.haskell.org/ghc/semaphore-compat.git + ignore = untracked [submodule "libraries/stm"] path = libraries/stm url = https://gitlab.haskell.org/ghc/packages/stm.git ===================================== cabal.project-reinstall ===================================== @@ -28,6 +28,7 @@ packages: ./compiler ./libraries/parsec/ -- ./libraries/pretty/ ./libraries/process/ + ./libraries/semaphore-compat ./libraries/stm -- ./libraries/template-haskell/ ./libraries/terminfo/ ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -75,6 +75,7 @@ import GHC.Driver.Env import GHC.Driver.Errors import GHC.Driver.Errors.Types import GHC.Driver.Main +import GHC.Driver.MakeSem import GHC.Parser.Header @@ -149,9 +150,9 @@ import GHC.Runtime.Loader import GHC.Rename.Names import GHC.Utils.Constants import GHC.Types.Unique.DFM (udfmRestrictKeysSet) -import qualified Data.IntSet as I import GHC.Types.Unique +import qualified Data.IntSet as I -- ----------------------------------------------------------------------------- -- Loading the program @@ -657,6 +658,30 @@ createBuildPlan mod_graph maybe_top_mod = (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (length (mgModSummaries' mod_graph )))]) build_plan +mkWorkerLimit :: DynFlags -> IO WorkerLimit +mkWorkerLimit dflags = + case parMakeCount dflags of + Nothing -> pure $ num_procs 1 + Just (ParMakeSemaphore h) -> pure (JSemLimit (SemaphoreName h)) + Just ParMakeNumProcessors -> num_procs <$> getNumProcessors + Just (ParMakeThisMany n) -> pure $ num_procs n + where + num_procs x = NumProcessorsLimit (max 1 x) + +isWorkerLimitSequential :: WorkerLimit -> Bool +isWorkerLimitSequential (NumProcessorsLimit x) = x <= 1 +isWorkerLimitSequential (JSemLimit {}) = False + +-- | This describes what we use to limit the number of jobs, either we limit it +-- ourselves to a specific number or we have an external parallelism semaphore +-- limit it for us. +data WorkerLimit + = NumProcessorsLimit Int + | JSemLimit + SemaphoreName + -- ^ Semaphore name to use + deriving Eq + -- | Generalized version of 'load' which also supports a custom -- 'Messager' (for reporting progress) and 'ModuleGraph' (generally -- produced by calling 'depanal'. @@ -737,14 +762,12 @@ load' mhmi_cache how_much mHscMessage mod_graph = do liftIO $ debugTraceMsg logger 2 (hang (text "Ready for upsweep") 2 (ppr build_plan)) - n_jobs <- case parMakeCount (hsc_dflags hsc_env) of - Nothing -> liftIO getNumProcessors - Just n -> return n + worker_limit <- liftIO $ mkWorkerLimit dflags setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do hsc_env <- getSession - liftIO $ upsweep n_jobs hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan + liftIO $ upsweep worker_limit hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan setSession hsc_env1 case upsweep_ok of Failed -> loadFinish upsweep_ok @@ -1029,13 +1052,7 @@ getDependencies direct_deps build_map = type BuildM a = StateT BuildLoopState IO a --- | Abstraction over the operations of a semaphore which allows usage with the --- -j1 case -data AbstractSem = AbstractSem { acquireSem :: IO () - , releaseSem :: IO () } -withAbstractSem :: AbstractSem -> IO b -> IO b -withAbstractSem sem = MC.bracket_ (acquireSem sem) (releaseSem sem) -- | Environment used when compiling a module data MakeEnv = MakeEnv { hsc_env :: !HscEnv -- The basic HscEnv which will be augmented for each module @@ -1220,7 +1237,7 @@ withCurrentUnit uid = do local (\env -> env { hsc_env = hscSetActiveUnitId uid (hsc_env env)}) upsweep - :: Int -- ^ The number of workers we wish to run in parallel + :: WorkerLimit -- ^ The number of workers we wish to run in parallel -> HscEnv -- ^ The base HscEnv, which is augmented for each module -> Maybe ModIfaceCache -- ^ A cache to incrementally write final interface files to -> Maybe Messager @@ -2825,7 +2842,7 @@ label_self thread_name = do CC.labelThread self_tid thread_name -runPipelines :: Int -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () +runPipelines :: WorkerLimit -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () -- Don't even initialise plugins if there are no pipelines runPipelines _ _ _ [] = return () runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do @@ -2833,7 +2850,7 @@ runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do plugins_hsc_env <- initializePlugins orig_hsc_env case n_job of - 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines + NumProcessorsLimit n | n <= 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines _n -> runParPipelines n_job plugins_hsc_env mHscMessager all_pipelines runSeqPipelines :: HscEnv -> Maybe Messager -> [MakeAction] -> IO () @@ -2843,16 +2860,38 @@ runSeqPipelines plugin_hsc_env mHscMessager all_pipelines = , compile_sem = AbstractSem (return ()) (return ()) , env_messager = mHscMessager } - in runAllPipelines 1 env all_pipelines + in runAllPipelines (NumProcessorsLimit 1) env all_pipelines +runNjobsAbstractSem :: Int -> (AbstractSem -> IO a) -> IO a +runNjobsAbstractSem n_jobs action = do + compile_sem <- newQSem n_jobs + n_capabilities <- getNumCapabilities + n_cpus <- getNumProcessors + let + asem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + set_num_caps n = unless (n_capabilities /= 1) $ setNumCapabilities n + updNumCapabilities = do + -- Setting number of capabilities more than + -- CPU count usually leads to high userspace + -- lock contention. #9221 + set_num_caps $ min n_jobs n_cpus + resetNumCapabilities = set_num_caps n_capabilities + MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem + +runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a +runWorkerLimit worker_limit action = case worker_limit of + NumProcessorsLimit n_jobs -> + runNjobsAbstractSem n_jobs action + JSemLimit sem -> + runJSemAbstractSem sem action -- | Build and run a pipeline -runParPipelines :: Int -- ^ How many capabilities to use - -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module +runParPipelines :: WorkerLimit -- ^ How to limit work parallelism + -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module -> Maybe Messager -- ^ Optional custom messager to use to report progress -> [MakeAction] -- ^ The build plan for all the module nodes -> IO () -runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do +runParPipelines worker_limit plugin_hsc_env mHscMessager all_pipelines = do -- A variable which we write to when an error has happened and we have to tell the @@ -2862,39 +2901,23 @@ runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do -- will add it's LogQueue into this queue. log_queue_queue_var <- newTVarIO newLogQueueQueue -- Thread which coordinates the printing of logs - wait_log_thread <- logThread n_jobs (length all_pipelines) (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var + wait_log_thread <- logThread (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var -- Make the logger thread-safe, in case there is some output which isn't sent via the LogQueue. thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env) let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger } - let updNumCapabilities = liftIO $ do - n_capabilities <- getNumCapabilities - n_cpus <- getNumProcessors - -- Setting number of capabilities more than - -- CPU count usually leads to high userspace - -- lock contention. #9221 - let n_caps = min n_jobs n_cpus - unless (n_capabilities /= 1) $ setNumCapabilities n_caps - return n_capabilities - - let resetNumCapabilities orig_n = do - liftIO $ setNumCapabilities orig_n - atomically $ writeTVar stopped_var True - wait_log_thread - - compile_sem <- newQSem n_jobs - let abstract_sem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + runWorkerLimit worker_limit $ \abstract_sem -> do + let env = MakeEnv { hsc_env = thread_safe_hsc_env + , withLogger = withParLog log_queue_queue_var + , compile_sem = abstract_sem + , env_messager = mHscMessager + } -- Reset the number of capabilities once the upsweep ends. - let env = MakeEnv { hsc_env = thread_safe_hsc_env - , withLogger = withParLog log_queue_queue_var - , compile_sem = abstract_sem - , env_messager = mHscMessager - } - - MC.bracket updNumCapabilities resetNumCapabilities $ \_ -> - runAllPipelines n_jobs env all_pipelines + runAllPipelines worker_limit env all_pipelines + atomically $ writeTVar stopped_var True + wait_log_thread withLocalTmpFS :: RunMakeM a -> RunMakeM a withLocalTmpFS act = do @@ -2911,10 +2934,11 @@ withLocalTmpFS act = do MC.bracket initialiser finaliser $ \lcl_hsc_env -> local (\env -> env { hsc_env = lcl_hsc_env}) act -- | Run the given actions and then wait for them all to finish. -runAllPipelines :: Int -> MakeEnv -> [MakeAction] -> IO () -runAllPipelines n_jobs env acts = do - let spawn_actions :: IO [ThreadId] - spawn_actions = if n_jobs == 1 +runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO () +runAllPipelines worker_limit env acts = do + let single_worker = isWorkerLimitSequential worker_limit + spawn_actions :: IO [ThreadId] + spawn_actions = if single_worker then (:[]) <$> (forkIOWithUnmask $ \unmask -> void $ runLoop (\io -> io unmask) env acts) else runLoop forkIOWithUnmask env acts ===================================== compiler/GHC/Driver/MakeSem.hs ===================================== @@ -0,0 +1,548 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE NumericUnderscores #-} + +-- | Implementation of a jobserver using system semaphores. +-- +-- +module GHC.Driver.MakeSem + ( -- * JSem: parallelism semaphore backed + -- by a system semaphore (Posix/Windows) + runJSemAbstractSem + + -- * System semaphores + , Semaphore, SemaphoreName(..) + + -- * Abstract semaphores + , AbstractSem(..) + , withAbstractSem + ) + where + +import GHC.Prelude +import GHC.Conc +import GHC.Data.OrdList +import GHC.IO.Exception +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Json + +import System.Semaphore + +import Control.Monad +import qualified Control.Monad.Catch as MC +import Control.Concurrent.MVar +import Control.Concurrent.STM +import Data.Foldable +import Data.Functor +import GHC.Stack +import Debug.Trace + +--------------------------------------- +-- Semaphore jobserver + +-- | A jobserver based off a system 'Semaphore'. +-- +-- Keeps track of the pending jobs and resources +-- available from the semaphore. +data Jobserver + = Jobserver + { jSemaphore :: !Semaphore + -- ^ The semaphore which controls available resources + , jobs :: !(TVar JobResources) + -- ^ The currently pending jobs, and the resources + -- obtained from the semaphore + } + +data JobserverOptions + = JobserverOptions + { releaseDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between acquiring a token + -- and releasing a token. + , setNumCapsDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between two consecutive + -- calls of 'setNumCapabilities'. + } + +defaultJobserverOptions :: JobserverOptions +defaultJobserverOptions = + JobserverOptions + { releaseDebounce = 1000 -- 1 second + , setNumCapsDebounce = 1000 -- 1 second + } + +-- | Resources available for running jobs, i.e. +-- tokens obtained from the parallelism semaphore. +data JobResources + = Jobs + { tokensOwned :: !Int + -- ^ How many tokens have been claimed from the semaphore + , tokensFree :: !Int + -- ^ How many tokens are not currently being used + , jobsWaiting :: !(OrdList (TMVar ())) + -- ^ Pending jobs waiting on a token, the job will be blocked on the TMVar so putting into + -- the TMVar will allow the job to continue. + } + +instance Outputable JobResources where + ppr Jobs{..} + = text "JobResources" <+> + ( braces $ hsep + [ text "owned=" <> ppr tokensOwned + , text "free=" <> ppr tokensFree + , text "num_waiting=" <> ppr (length jobsWaiting) + ] ) + +-- | Add one new token. +addToken :: JobResources -> JobResources +addToken jobs@( Jobs { tokensOwned = owned, tokensFree = free }) + = jobs { tokensOwned = owned + 1, tokensFree = free + 1 } + +-- | Free one token. +addFreeToken :: JobResources -> JobResources +addFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (tokensOwned jobs > free) + (text "addFreeToken:" <+> ppr (tokensOwned jobs) <+> ppr free) + $ jobs { tokensFree = free + 1 } + +-- | Use up one token. +removeFreeToken :: JobResources -> JobResources +removeFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (free > 0) + (text "removeFreeToken:" <+> ppr free) + $ jobs { tokensFree = free - 1 } + +-- | Return one owned token. +removeOwnedToken :: JobResources -> JobResources +removeOwnedToken jobs@( Jobs { tokensOwned = owned }) + = assertPpr (owned > 1) + (text "removeOwnedToken:" <+> ppr owned) + $ jobs { tokensOwned = owned - 1 } + +-- | Add one new job to the end of the list of pending jobs. +addJob :: TMVar () -> JobResources -> JobResources +addJob job jobs@( Jobs { jobsWaiting = wait }) + = jobs { jobsWaiting = wait `SnocOL` job } + +-- | The state of the semaphore job server. +data JobserverState + = JobserverState + { jobserverAction :: !JobserverAction + -- ^ The current action being performed by the + -- job server. + , canChangeNumCaps :: !(TVar Bool) + -- ^ A TVar that signals whether it has been long + -- enough since we last changed 'numCapabilities'. + , canReleaseToken :: !(TVar Bool) + -- ^ A TVar that signals whether we last acquired + -- a token long enough ago that we can now release + -- a token. + } +data JobserverAction + -- | The jobserver is idle: no thread is currently + -- interacting with the semaphore. + = Idle + -- | A thread is waiting for a token on the semaphore. + | Acquiring + { activeWaitId :: WaitId + , threadFinished :: TMVar (Maybe MC.SomeException) } + +-- | Retrieve the 'TMVar' that signals if the current thread has finished, +-- if any thread is currently active in the jobserver. +activeThread_maybe :: JobserverAction -> Maybe (TMVar (Maybe MC.SomeException)) +activeThread_maybe Idle = Nothing +activeThread_maybe (Acquiring { threadFinished = tmvar }) = Just tmvar + +-- | Whether we should try to acquire a new token from the semaphore: +-- there is a pending job and no free tokens. +guardAcquire :: JobResources -> Bool +guardAcquire ( Jobs { tokensFree, jobsWaiting } ) + = tokensFree == 0 && not (null jobsWaiting) + +-- | Whether we should release a token from the semaphore: +-- there are no pending jobs and we can release a token. +guardRelease :: JobResources -> Bool +guardRelease ( Jobs { tokensFree, tokensOwned, jobsWaiting } ) + = null jobsWaiting && tokensFree > 0 && tokensOwned > 1 + +--------------------------------------- +-- Semaphore jobserver implementation + +-- | Add one pending job to the jobserver. +-- +-- Blocks, waiting on the jobserver to supply a free token. +acquireJob :: TVar JobResources -> IO () +acquireJob jobs_tvar = do + (job_tmvar, _jobs0) <- tracedAtomically "acquire" $ + modifyJobResources jobs_tvar \ jobs -> do + job_tmvar <- newEmptyTMVar + return ((job_tmvar, jobs), addJob job_tmvar jobs) + atomically $ takeTMVar job_tmvar + +-- | Signal to the job server that one job has completed, +-- releasing its corresponding token. +releaseJob :: TVar JobResources -> IO () +releaseJob jobs_tvar = do + tracedAtomically "release" do + modifyJobResources jobs_tvar \ jobs -> do + massertPpr (tokensFree jobs < tokensOwned jobs) + (text "releaseJob: more free jobs than owned jobs!") + return ((), addFreeToken jobs) + + +-- | Release all tokens owned from the semaphore (to clean up +-- the jobserver at the end). +cleanupJobserver :: Jobserver -> IO () +cleanupJobserver (Jobserver { jSemaphore = sem + , jobs = jobs_tvar }) + = do + Jobs { tokensOwned = owned } <- readTVarIO jobs_tvar + let toks_to_release = owned - 1 + -- Subtract off the implicit token: whoever spawned the ghc process + -- in the first place is responsible for that token. + releaseSemaphore sem toks_to_release + +-- | Dispatch the available tokens acquired from the semaphore +-- to the pending jobs in the job server. +dispatchTokens :: JobResources -> STM JobResources +dispatchTokens jobs@( Jobs { tokensFree = toks_free, jobsWaiting = wait } ) + | toks_free > 0 + , next `ConsOL` rest <- wait + -- There's a pending job and a free token: + -- pass on the token to that job, and recur. + = do + putTMVar next () + let jobs' = jobs { tokensFree = toks_free - 1, jobsWaiting = rest } + dispatchTokens jobs' + | otherwise + = return jobs + +-- | Update the available resources used from a semaphore, dispatching +-- any newly acquired resources. +-- +-- Invariant: if the number of available resources decreases, there +-- must be no pending jobs. +-- +-- All modifications should go through this function to ensure the contents +-- of the 'TVar' remains in normal form. +modifyJobResources :: HasCallStack => TVar JobResources + -> (JobResources -> STM (a, JobResources)) + -> STM (a, Maybe JobResources) +modifyJobResources jobs_tvar action = do + old_jobs <- readTVar jobs_tvar + (a, jobs) <- action old_jobs + + -- Check the invariant: if the number of free tokens has decreased, + -- there must be no pending jobs. + massertPpr (null (jobsWaiting jobs) || tokensFree jobs >= tokensFree old_jobs) $ + vcat [ text "modiyJobResources: pending jobs but fewer free tokens" ] + dispatched_jobs <- dispatchTokens jobs + writeTVar jobs_tvar dispatched_jobs + return (a, Just dispatched_jobs) + + +tracedAtomically_ :: String -> STM (Maybe JobResources) -> IO () +tracedAtomically_ s act = tracedAtomically s (((),) <$> act) + +tracedAtomically :: String -> STM (a, Maybe JobResources) -> IO a +tracedAtomically origin act = do + (a, mjr) <- atomically act + forM_ mjr $ \ jr -> do + -- Use the "jsem:" prefix to identify where the write traces are + traceEventIO ("jsem:" ++ renderJobResources origin jr) + return a + +renderJobResources :: String -> JobResources -> String +renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON $ + JSObject [ ("name", JSString origin) + , ("owned", JSInt own) + , ("free", JSInt free) + , ("pending", JSInt (length pending) ) + ] + + +-- | Spawn a new thread that waits on the semaphore in order to acquire +-- an additional token. +acquireThread :: Jobserver -> IO JobserverAction +acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + let + wait_result_action :: Either MC.SomeException Bool -> IO () + wait_result_action wait_res = + tracedAtomically_ "acquire_thread" do + (r, jb) <- case wait_res of + Left (e :: MC.SomeException) -> do + return $ (Just e, Nothing) + Right success -> do + if success + then do + modifyJobResources jobs_tvar \ jobs -> + return (Nothing, addToken jobs) + else + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jb + wait_id <- forkWaitOnSemaphoreInterruptible sem wait_result_action + labelThread (waitingThreadId wait_id) "acquire_thread" + return $ Acquiring { activeWaitId = wait_id + , threadFinished = threadFinished_tmvar } + +-- | Spawn a thread to release ownership of one resource from the semaphore, +-- provided we have spare resources and no pending jobs. +releaseThread :: Jobserver -> IO JobserverAction +releaseThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + MC.mask_ do + -- Pre-release the resource so that another thread doesn't take control of it + -- just as we release the lock on the semaphore. + still_ok_to_release + <- tracedAtomically "pre_release" $ + modifyJobResources jobs_tvar \ jobs -> + if guardRelease jobs + -- TODO: should this also debounce? + then return (True , removeOwnedToken $ removeFreeToken jobs) + else return (False, jobs) + if not still_ok_to_release + then return Idle + else do + tid <- forkIO $ do + x <- MC.try $ releaseSemaphore sem 1 + tracedAtomically_ "post-release" $ do + (r, jobs) <- case x of + Left (e :: MC.SomeException) -> do + modifyJobResources jobs_tvar \ jobs -> + return (Just e, addToken jobs) + Right _ -> do + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jobs + labelThread tid "release_thread" + return Idle + +-- | When there are pending jobs but no free tokens, +-- spawn a thread to acquire a new token from the semaphore. +-- +-- See 'acquireThread'. +tryAcquire :: JobserverOptions + -> Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryAcquire opts js@( Jobserver { jobs = jobs_tvar }) + st@( JobserverState { jobserverAction = Idle } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardAcquire jobs + return do + action <- acquireThread js + -- Set a debounce after acquiring a token. + can_release_tvar <- registerDelay $ (releaseDebounce opts * 1000) + return $ st { jobserverAction = action + , canReleaseToken = can_release_tvar } +tryAcquire _ _ _ = retry + +-- | When there are free tokens and no pending jobs, +-- spawn a thread to release a token from the semamphore. +-- +-- See 'releaseThread'. +tryRelease :: Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryRelease sjs@( Jobserver { jobs = jobs_tvar } ) + st@( JobserverState + { jobserverAction = Idle + , canReleaseToken = can_release_tvar } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardRelease jobs + can_release <- readTVar can_release_tvar + guard can_release + return do + action <- releaseThread sjs + return $ st { jobserverAction = action } +tryRelease _ _ = retry + +-- | Wait for an active thread to finish. Once it finishes: +-- +-- - set the 'JobserverAction' to 'Idle', +-- - update the number of capabilities to reflect the number +-- of owned tokens from the semaphore. +tryNoticeIdle :: JobserverOptions + -> TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryNoticeIdle opts jobs_tvar jobserver_state + | Just threadFinished_tmvar <- activeThread_maybe $ jobserverAction jobserver_state + = sync_num_caps (canChangeNumCaps jobserver_state) threadFinished_tmvar + | otherwise + = retry -- no active thread: wait until jobserver isn't idle + where + sync_num_caps :: TVar Bool + -> TMVar (Maybe MC.SomeException) + -> STM (IO JobserverState) + sync_num_caps can_change_numcaps_tvar threadFinished_tmvar = do + mb_ex <- takeTMVar threadFinished_tmvar + for_ mb_ex MC.throwM + Jobs { tokensOwned } <- readTVar jobs_tvar + can_change_numcaps <- readTVar can_change_numcaps_tvar + guard can_change_numcaps + return do + x <- getNumCapabilities + can_change_numcaps_tvar_2 <- + if x == tokensOwned + then return can_change_numcaps_tvar + else do + setNumCapabilities tokensOwned + registerDelay $ (setNumCapsDebounce opts * 1000) + return $ + jobserver_state + { jobserverAction = Idle + , canChangeNumCaps = can_change_numcaps_tvar_2 } + +-- | Try to stop the current thread which is acquiring/releasing resources +-- if that operation is no longer relevant. +tryStopThread :: TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryStopThread jobs_tvar jsj = do + case jobserverAction jsj of + Acquiring { activeWaitId = wait_id } -> do + jobs <- readTVar jobs_tvar + guard $ null (jobsWaiting jobs) + return do + interruptWaitOnSemaphore wait_id + return $ jsj { jobserverAction = Idle } + _ -> retry + +-- | Main jobserver loop: acquire/release resources as +-- needed for the pending jobs and available semaphore tokens. +jobserverLoop :: JobserverOptions -> Jobserver -> IO () +jobserverLoop opts sjs@(Jobserver { jobs = jobs_tvar }) + = do + true_tvar <- newTVarIO True + let init_state :: JobserverState + init_state = + JobserverState + { jobserverAction = Idle + , canChangeNumCaps = true_tvar + , canReleaseToken = true_tvar } + loop init_state + where + loop s = do + action <- atomically $ asum $ (\x -> x s) <$> + [ tryRelease sjs + , tryAcquire opts sjs + , tryNoticeIdle opts jobs_tvar + , tryStopThread jobs_tvar + ] + s <- action + loop s + +-- | Create a new jobserver using the given semaphore handle. +makeJobserver :: SemaphoreName -> IO (AbstractSem, IO ()) +makeJobserver sem_name = do + semaphore <- openSemaphore sem_name + let + init_jobs = + Jobs { tokensOwned = 1 + , tokensFree = 1 + , jobsWaiting = NilOL + } + jobs_tvar <- newTVarIO init_jobs + let + opts = defaultJobserverOptions -- TODO: allow this to be configured + sjs = Jobserver { jSemaphore = semaphore + , jobs = jobs_tvar } + loop_finished_mvar <- newEmptyMVar + loop_tid <- forkIOWithUnmask \ unmask -> do + r <- try $ unmask $ jobserverLoop opts sjs + putMVar loop_finished_mvar $ + case r of + Left e + | Just ThreadKilled <- fromException e + -> Nothing + | otherwise + -> Just e + Right () -> Nothing + labelThread loop_tid "job_server" + let + acquireSem = acquireJob jobs_tvar + releaseSem = releaseJob jobs_tvar + cleanupSem = do + -- this is interruptible + cleanupJobserver sjs + killThread loop_tid + mb_ex <- takeMVar loop_finished_mvar + for_ mb_ex MC.throwM + + return (AbstractSem{..}, cleanupSem) + +-- | Implement an abstract semaphore using a semaphore 'Jobserver' +-- which queries the system semaphore of the given name for resources. +runJSemAbstractSem :: SemaphoreName -- ^ the system semaphore to use + -> (AbstractSem -> IO a) -- ^ the operation to run + -- which requires a semaphore + -> IO a +runJSemAbstractSem sem action = MC.mask \ unmask -> do + (abs, cleanup) <- makeJobserver sem + r <- try $ unmask $ action abs + case r of + Left (e1 :: MC.SomeException) -> do + (_ :: Either MC.SomeException ()) <- MC.try cleanup + MC.throwM e1 + Right x -> cleanup $> x + +{- +Note [Architecture of the Job Server] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In `-jsem` mode, the amount of parallelism that GHC can use is controlled by a +system semaphore. We take resources from the semaphore when we need them, and +give them back if we don't have enough to do. + +A naive implementation would just take and release the semaphore around performing +the action, but this leads to two issues: + +* When taking a token in the semaphore, we must call `setNumCapabilities` in order + to adjust how many capabilities are available for parallel garbage collection. + This causes unnecessary synchronisations. +* We want to implement a debounce, so that whilst there is pending work in the + current process we prefer to keep hold of resources from the semaphore. + This reduces overall memory usage, as there are fewer live GHC processes at once. + +Therefore, the obtention of semaphore resources is separated away from the +request for the resource in the driver. + +A token from the semaphore is requested using `acquireJob`. This creates a pending +job, which is a MVar that can be filled in to signal that the requested token is ready. + +When the job is finished, the token is released by calling `releaseJob`, which just +increases the number of `free` jobs. If there are more pending jobs when the free count +is increased, the token is immediately reused (see `modifyJobResources`). + +The `jobServerLoop` interacts with the system semaphore: when there are pending +jobs, `acquireThread` blocks, waiting for a token from the semaphore. Once a +token is obtained, it increases the owned count. + +When GHC has free tokens (tokens from the semaphore that it is not using), +no pending jobs, and the debounce has expired, then `releaseThread` will +release tokens back to the global semaphore. + +`tryStopThread` attempts to kill threads which are waiting to acquire a resource +when we no longer need it. For example, consider that we attempt to acquire two +tokens, but the first job finishes before we acquire the second token. +This second token is no longer needed, so we should cancel the wait +(as it would not be used to do any work, and not be returned until the debounce). +We only need to kill `acquireJob`, because `releaseJob` never blocks. + +Note [Eventlog Messages for jsem] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +It can be tricky to verify that the work is shared adequately across different +processes. To help debug this, we output the values of `JobResource` to the +eventlog whenever the global state changes. There are some scripts which can be used +to analyse this output and report statistics about core saturation in the +GitHub repo (https://github.com/mpickering/ghc-jsem-analyse). + +-} ===================================== compiler/GHC/Driver/Pipeline/LogQueue.hs ===================================== @@ -100,10 +100,10 @@ dequeueLogQueueQueue (LogQueueQueue n lqq) = case IM.minViewWithKey lqq of Just ((k, v), lqq') | k == n -> Just (v, LogQueueQueue (n + 1) lqq') _ -> Nothing -logThread :: Int -> Int -> Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit +logThread :: Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit -> TVar LogQueueQueue -- Queue for logs -> IO (IO ()) -logThread _ _ logger stopped lqq_var = do +logThread logger stopped lqq_var = do finished_var <- newEmptyMVar _ <- forkIO $ print_logs *> putMVar finished_var () return (takeMVar finished_var) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -43,6 +43,7 @@ module GHC.Driver.Session ( needSourceNotes, OnOff(..), DynFlags(..), + ParMakeCount(..), outputFile, objectSuf, ways, FlagSpec(..), HasDynFlags(..), ContainsDynFlags(..), @@ -461,9 +462,9 @@ data DynFlags = DynFlags { ruleCheck :: Maybe String, strictnessBefore :: [Int], -- ^ Additional demand analysis - parMakeCount :: Maybe Int, -- ^ The number of modules to compile in parallel - -- in --make mode, where Nothing ==> compile as - -- many in parallel as there are CPUs. + parMakeCount :: Maybe ParMakeCount, + -- ^ The number of modules to compile in parallel + -- If unspecified, compile with a single job. enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? ghcHeapSize :: Maybe Int, -- ^ The heap size to set. @@ -783,6 +784,13 @@ instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where class ContainsDynFlags t where extractDynFlags :: t -> DynFlags +-- | The type for the -jN argument, specifying that -j on its own represents +-- using the number of machine processors. +data ParMakeCount + = ParMakeThisMany Int -- -j + | ParMakeSemaphore FilePath --jsem + | ParMakeNumProcessors -- -j + ----------------------------------------------------------------------------- -- Accessors from 'DynFlags' @@ -1146,7 +1154,7 @@ defaultDynFlags mySettings = historySize = 20, strictnessBefore = [], - parMakeCount = Just 1, + parMakeCount = Nothing, enableTimeStats = False, ghcHeapSize = Nothing, @@ -2066,14 +2074,16 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "j" (OptIntSuffix (\n -> case n of Just n - | n > 0 -> upd (\d -> d { parMakeCount = Just n }) + | n > 0 -> upd (\d -> d { parMakeCount = Just (ParMakeThisMany n) }) | otherwise -> addErr "Syntax: -j[n] where n > 0" - Nothing -> upd (\d -> d { parMakeCount = Nothing }))) + Nothing -> upd (\d -> d { parMakeCount = Just ParMakeNumProcessors }))) -- When the number of parallel builds -- is omitted, it is the same -- as specifying that the number of -- parallel builds is equal to the -- result of getNumProcessors + , make_ord_flag defGhcFlag "jsem" $ hasArg $ \f d -> d { parMakeCount = Just (ParMakeSemaphore f) } + , make_ord_flag defFlag "instantiated-with" (sepArg setUnitInstantiations) , make_ord_flag defFlag "this-component-id" (sepArg setUnitInstanceOf) ===================================== compiler/ghc.cabal.in ===================================== @@ -85,6 +85,7 @@ Library hpc == 0.6.*, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, + semaphore-compat, stm, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, @@ -436,6 +437,7 @@ Library GHC.Driver.GenerateCgIPEStub GHC.Driver.Hooks GHC.Driver.LlvmConfigCache + GHC.Driver.MakeSem GHC.Driver.Main GHC.Driver.Make GHC.Driver.MakeFile ===================================== docs/users_guide/using.rst ===================================== @@ -751,6 +751,61 @@ search path (see :ref:`search-path`). number of processors. Note that compilation of a module may not begin until its dependencies have been built. + +GHC Jobserver Protocol +~~~~~~~~~~~~~~~~~~~~~~ + +The GHC Jobserver Protocol was specified in `GHC proposal #540 `__. + +This protocol allows +a server to dynamically invoke many instances of a client process, +while restricting all of those instances to use no more than capabilities. +This is achieved by coordination over a system semaphore (either a POSIX +semaphore in the case of Linux and Darwin, or a Win32 semaphore +in the case of Windows platforms). + +There are two kinds of participants in the GHC Jobserver protocol: + +- The *jobserver* creates a system semaphore with a certain number of + available tokens. + + Each time the jobserver wants to spawn a new jobclient subprocess, it **must** + first acquire a single token from the semaphore, before spawning + the subprocess. This token **must** be released once the subprocess terminates. + + Once work is finished, the jobserver **must** destroy the semaphore it created. + +- A *jobclient* is a subprocess spawned by the jobserver or another jobclient. + + Each jobclient starts with one available token (its *implicit token*, + which was acquired by the parent which spawned it), and can request more + tokens through the Jobserver Protocol by waiting on the semaphore. + + Each time a jobclient wants to spawn a new jobclient subprocess, it **must** + pass on a single token to the child jobclient. This token can either be the + jobclient's implicit token, or another token which the jobclient acquired + from the semaphore. + + Each jobclient **must** release exactly as many tokens as it has acquired from + the semaphore (this does not include the implicit tokens). + + GHC itself acts as a jobclient which can be enabled by using the flag ``-jsem``. + +.. ghc-flag:: -jsem + :shortdesc: When compiling with :ghc-flag:`--make`, coordinate with + other processes through the semaphore ⟨sem⟩ to compile + modules in parallel. + :type: dynamic + :category: misc + + Perform compilation in parallel when possible, coordinating with other + processes through the semaphore ⟨sem⟩. + Error if the semaphore doesn't exist. + + Use of ``-jsem`` will override use of `-j[⟨n⟩]`:ghc-flag:. + + + .. _multi-home-units: Multiple Home Units ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -39,7 +39,7 @@ ghcPackages = , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl - , parsec, pretty, process, rts, runGhc, stm, templateHaskell + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon @@ -55,7 +55,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, - parsec, pretty, primitive, process, rts, runGhc, stm, templateHaskell, + parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -110,6 +110,7 @@ process = lib "process" remoteIserv = util "remote-iserv" rts = top "rts" runGhc = util "runghc" +semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" terminfo = lib "terminfo" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -171,6 +171,7 @@ toolTargets = [ binary , templateHaskell , text , transformers + , semaphoreCompat , unlit -- # executable ] ++ if windowsHost then [ win32 ] else [ unix ] ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -95,6 +95,7 @@ stage0Packages = do , hpcBin , mtl , parsec + , semaphoreCompat , time , templateHaskell , text @@ -142,6 +143,7 @@ stage1Packages = do , integerGmp , pretty , rts + , semaphoreCompat , stm , unlit , xhtml ===================================== libraries/semaphore-compat ===================================== @@ -0,0 +1 @@ +Subproject commit 663ef75467995acf41c51d3e21d03347e85b844e ===================================== packages ===================================== @@ -65,5 +65,6 @@ libraries/Win32 - - https:/ libraries/xhtml - - https://github.com/haskell/xhtml.git libraries/exceptions - - https://github.com/ekmett/exceptions.git nofib nofib - - +libraries/semaphore-compat - - - libraries/stm - - ssh://git at github.com/haskell/stm.git . - ghc.git - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51290f4b12816ba23f240c97f266bef7bcd99bbd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51290f4b12816ba23f240c97f266bef7bcd99bbd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 10:18:55 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 23 Mar 2023 06:18:55 -0400 Subject: [Git][ghc/ghc][wip/jsem] Implement -jsem: parallelism controlled by semaphores Message-ID: <641c278f9ff80_90da48a80e10841629@gitlab.mail> Matthew Pickering pushed to branch wip/jsem at Glasgow Haskell Compiler / GHC Commits: 2f5dee7a by sheaf at 2023-03-23T10:18:40+00:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 14 changed files: - .gitmodules - cabal.project-reinstall - compiler/GHC/Driver/Make.hs - + compiler/GHC/Driver/MakeSem.hs - compiler/GHC/Driver/Pipeline/LogQueue.hs - compiler/GHC/Driver/Session.hs - compiler/ghc.cabal.in - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using.rst - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - + libraries/semaphore-compat - packages Changes: ===================================== .gitmodules ===================================== @@ -83,6 +83,10 @@ url = https://gitlab.haskell.org/ghc/packages/unix.git ignore = untracked branch = 2.7 +[submodule "libraries/semaphore-compat"] + path = libraries/semaphore-compat + url = https://gitlab.haskell.org/ghc/semaphore-compat.git + ignore = untracked [submodule "libraries/stm"] path = libraries/stm url = https://gitlab.haskell.org/ghc/packages/stm.git ===================================== cabal.project-reinstall ===================================== @@ -28,6 +28,7 @@ packages: ./compiler ./libraries/parsec/ -- ./libraries/pretty/ ./libraries/process/ + ./libraries/semaphore-compat ./libraries/stm -- ./libraries/template-haskell/ ./libraries/terminfo/ ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -75,6 +75,7 @@ import GHC.Driver.Env import GHC.Driver.Errors import GHC.Driver.Errors.Types import GHC.Driver.Main +import GHC.Driver.MakeSem import GHC.Parser.Header @@ -149,9 +150,9 @@ import GHC.Runtime.Loader import GHC.Rename.Names import GHC.Utils.Constants import GHC.Types.Unique.DFM (udfmRestrictKeysSet) -import qualified Data.IntSet as I import GHC.Types.Unique +import qualified Data.IntSet as I -- ----------------------------------------------------------------------------- -- Loading the program @@ -657,6 +658,30 @@ createBuildPlan mod_graph maybe_top_mod = (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (length (mgModSummaries' mod_graph )))]) build_plan +mkWorkerLimit :: DynFlags -> IO WorkerLimit +mkWorkerLimit dflags = + case parMakeCount dflags of + Nothing -> pure $ num_procs 1 + Just (ParMakeSemaphore h) -> pure (JSemLimit (SemaphoreName h)) + Just ParMakeNumProcessors -> num_procs <$> getNumProcessors + Just (ParMakeThisMany n) -> pure $ num_procs n + where + num_procs x = NumProcessorsLimit (max 1 x) + +isWorkerLimitSequential :: WorkerLimit -> Bool +isWorkerLimitSequential (NumProcessorsLimit x) = x <= 1 +isWorkerLimitSequential (JSemLimit {}) = False + +-- | This describes what we use to limit the number of jobs, either we limit it +-- ourselves to a specific number or we have an external parallelism semaphore +-- limit it for us. +data WorkerLimit + = NumProcessorsLimit Int + | JSemLimit + SemaphoreName + -- ^ Semaphore name to use + deriving Eq + -- | Generalized version of 'load' which also supports a custom -- 'Messager' (for reporting progress) and 'ModuleGraph' (generally -- produced by calling 'depanal'. @@ -737,14 +762,12 @@ load' mhmi_cache how_much mHscMessage mod_graph = do liftIO $ debugTraceMsg logger 2 (hang (text "Ready for upsweep") 2 (ppr build_plan)) - n_jobs <- case parMakeCount (hsc_dflags hsc_env) of - Nothing -> liftIO getNumProcessors - Just n -> return n + worker_limit <- liftIO $ mkWorkerLimit dflags setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do hsc_env <- getSession - liftIO $ upsweep n_jobs hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan + liftIO $ upsweep worker_limit hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan setSession hsc_env1 case upsweep_ok of Failed -> loadFinish upsweep_ok @@ -1029,13 +1052,7 @@ getDependencies direct_deps build_map = type BuildM a = StateT BuildLoopState IO a --- | Abstraction over the operations of a semaphore which allows usage with the --- -j1 case -data AbstractSem = AbstractSem { acquireSem :: IO () - , releaseSem :: IO () } -withAbstractSem :: AbstractSem -> IO b -> IO b -withAbstractSem sem = MC.bracket_ (acquireSem sem) (releaseSem sem) -- | Environment used when compiling a module data MakeEnv = MakeEnv { hsc_env :: !HscEnv -- The basic HscEnv which will be augmented for each module @@ -1220,7 +1237,7 @@ withCurrentUnit uid = do local (\env -> env { hsc_env = hscSetActiveUnitId uid (hsc_env env)}) upsweep - :: Int -- ^ The number of workers we wish to run in parallel + :: WorkerLimit -- ^ The number of workers we wish to run in parallel -> HscEnv -- ^ The base HscEnv, which is augmented for each module -> Maybe ModIfaceCache -- ^ A cache to incrementally write final interface files to -> Maybe Messager @@ -2825,7 +2842,7 @@ label_self thread_name = do CC.labelThread self_tid thread_name -runPipelines :: Int -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () +runPipelines :: WorkerLimit -> HscEnv -> Maybe Messager -> [MakeAction] -> IO () -- Don't even initialise plugins if there are no pipelines runPipelines _ _ _ [] = return () runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do @@ -2833,7 +2850,7 @@ runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do plugins_hsc_env <- initializePlugins orig_hsc_env case n_job of - 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines + NumProcessorsLimit n | n <= 1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines _n -> runParPipelines n_job plugins_hsc_env mHscMessager all_pipelines runSeqPipelines :: HscEnv -> Maybe Messager -> [MakeAction] -> IO () @@ -2843,16 +2860,38 @@ runSeqPipelines plugin_hsc_env mHscMessager all_pipelines = , compile_sem = AbstractSem (return ()) (return ()) , env_messager = mHscMessager } - in runAllPipelines 1 env all_pipelines + in runAllPipelines (NumProcessorsLimit 1) env all_pipelines +runNjobsAbstractSem :: Int -> (AbstractSem -> IO a) -> IO a +runNjobsAbstractSem n_jobs action = do + compile_sem <- newQSem n_jobs + n_capabilities <- getNumCapabilities + n_cpus <- getNumProcessors + let + asem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + set_num_caps n = unless (n_capabilities /= 1) $ setNumCapabilities n + updNumCapabilities = do + -- Setting number of capabilities more than + -- CPU count usually leads to high userspace + -- lock contention. #9221 + set_num_caps $ min n_jobs n_cpus + resetNumCapabilities = set_num_caps n_capabilities + MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem + +runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a +runWorkerLimit worker_limit action = case worker_limit of + NumProcessorsLimit n_jobs -> + runNjobsAbstractSem n_jobs action + JSemLimit sem -> + runJSemAbstractSem sem action -- | Build and run a pipeline -runParPipelines :: Int -- ^ How many capabilities to use - -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module +runParPipelines :: WorkerLimit -- ^ How to limit work parallelism + -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module -> Maybe Messager -- ^ Optional custom messager to use to report progress -> [MakeAction] -- ^ The build plan for all the module nodes -> IO () -runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do +runParPipelines worker_limit plugin_hsc_env mHscMessager all_pipelines = do -- A variable which we write to when an error has happened and we have to tell the @@ -2862,39 +2901,23 @@ runParPipelines n_jobs plugin_hsc_env mHscMessager all_pipelines = do -- will add it's LogQueue into this queue. log_queue_queue_var <- newTVarIO newLogQueueQueue -- Thread which coordinates the printing of logs - wait_log_thread <- logThread n_jobs (length all_pipelines) (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var + wait_log_thread <- logThread (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var -- Make the logger thread-safe, in case there is some output which isn't sent via the LogQueue. thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env) let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger } - let updNumCapabilities = liftIO $ do - n_capabilities <- getNumCapabilities - n_cpus <- getNumProcessors - -- Setting number of capabilities more than - -- CPU count usually leads to high userspace - -- lock contention. #9221 - let n_caps = min n_jobs n_cpus - unless (n_capabilities /= 1) $ setNumCapabilities n_caps - return n_capabilities - - let resetNumCapabilities orig_n = do - liftIO $ setNumCapabilities orig_n - atomically $ writeTVar stopped_var True - wait_log_thread - - compile_sem <- newQSem n_jobs - let abstract_sem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + runWorkerLimit worker_limit $ \abstract_sem -> do + let env = MakeEnv { hsc_env = thread_safe_hsc_env + , withLogger = withParLog log_queue_queue_var + , compile_sem = abstract_sem + , env_messager = mHscMessager + } -- Reset the number of capabilities once the upsweep ends. - let env = MakeEnv { hsc_env = thread_safe_hsc_env - , withLogger = withParLog log_queue_queue_var - , compile_sem = abstract_sem - , env_messager = mHscMessager - } - - MC.bracket updNumCapabilities resetNumCapabilities $ \_ -> - runAllPipelines n_jobs env all_pipelines + runAllPipelines worker_limit env all_pipelines + atomically $ writeTVar stopped_var True + wait_log_thread withLocalTmpFS :: RunMakeM a -> RunMakeM a withLocalTmpFS act = do @@ -2911,10 +2934,11 @@ withLocalTmpFS act = do MC.bracket initialiser finaliser $ \lcl_hsc_env -> local (\env -> env { hsc_env = lcl_hsc_env}) act -- | Run the given actions and then wait for them all to finish. -runAllPipelines :: Int -> MakeEnv -> [MakeAction] -> IO () -runAllPipelines n_jobs env acts = do - let spawn_actions :: IO [ThreadId] - spawn_actions = if n_jobs == 1 +runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO () +runAllPipelines worker_limit env acts = do + let single_worker = isWorkerLimitSequential worker_limit + spawn_actions :: IO [ThreadId] + spawn_actions = if single_worker then (:[]) <$> (forkIOWithUnmask $ \unmask -> void $ runLoop (\io -> io unmask) env acts) else runLoop forkIOWithUnmask env acts ===================================== compiler/GHC/Driver/MakeSem.hs ===================================== @@ -0,0 +1,548 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE NumericUnderscores #-} + +-- | Implementation of a jobserver using system semaphores. +-- +-- +module GHC.Driver.MakeSem + ( -- * JSem: parallelism semaphore backed + -- by a system semaphore (Posix/Windows) + runJSemAbstractSem + + -- * System semaphores + , Semaphore, SemaphoreName(..) + + -- * Abstract semaphores + , AbstractSem(..) + , withAbstractSem + ) + where + +import GHC.Prelude +import GHC.Conc +import GHC.Data.OrdList +import GHC.IO.Exception +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Json + +import System.Semaphore + +import Control.Monad +import qualified Control.Monad.Catch as MC +import Control.Concurrent.MVar +import Control.Concurrent.STM +import Data.Foldable +import Data.Functor +import GHC.Stack +import Debug.Trace + +--------------------------------------- +-- Semaphore jobserver + +-- | A jobserver based off a system 'Semaphore'. +-- +-- Keeps track of the pending jobs and resources +-- available from the semaphore. +data Jobserver + = Jobserver + { jSemaphore :: !Semaphore + -- ^ The semaphore which controls available resources + , jobs :: !(TVar JobResources) + -- ^ The currently pending jobs, and the resources + -- obtained from the semaphore + } + +data JobserverOptions + = JobserverOptions + { releaseDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between acquiring a token + -- and releasing a token. + , setNumCapsDebounce :: !Int + -- ^ Minimum delay, in milliseconds, between two consecutive + -- calls of 'setNumCapabilities'. + } + +defaultJobserverOptions :: JobserverOptions +defaultJobserverOptions = + JobserverOptions + { releaseDebounce = 1000 -- 1 second + , setNumCapsDebounce = 1000 -- 1 second + } + +-- | Resources available for running jobs, i.e. +-- tokens obtained from the parallelism semaphore. +data JobResources + = Jobs + { tokensOwned :: !Int + -- ^ How many tokens have been claimed from the semaphore + , tokensFree :: !Int + -- ^ How many tokens are not currently being used + , jobsWaiting :: !(OrdList (TMVar ())) + -- ^ Pending jobs waiting on a token, the job will be blocked on the TMVar so putting into + -- the TMVar will allow the job to continue. + } + +instance Outputable JobResources where + ppr Jobs{..} + = text "JobResources" <+> + ( braces $ hsep + [ text "owned=" <> ppr tokensOwned + , text "free=" <> ppr tokensFree + , text "num_waiting=" <> ppr (length jobsWaiting) + ] ) + +-- | Add one new token. +addToken :: JobResources -> JobResources +addToken jobs@( Jobs { tokensOwned = owned, tokensFree = free }) + = jobs { tokensOwned = owned + 1, tokensFree = free + 1 } + +-- | Free one token. +addFreeToken :: JobResources -> JobResources +addFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (tokensOwned jobs > free) + (text "addFreeToken:" <+> ppr (tokensOwned jobs) <+> ppr free) + $ jobs { tokensFree = free + 1 } + +-- | Use up one token. +removeFreeToken :: JobResources -> JobResources +removeFreeToken jobs@( Jobs { tokensFree = free }) + = assertPpr (free > 0) + (text "removeFreeToken:" <+> ppr free) + $ jobs { tokensFree = free - 1 } + +-- | Return one owned token. +removeOwnedToken :: JobResources -> JobResources +removeOwnedToken jobs@( Jobs { tokensOwned = owned }) + = assertPpr (owned > 1) + (text "removeOwnedToken:" <+> ppr owned) + $ jobs { tokensOwned = owned - 1 } + +-- | Add one new job to the end of the list of pending jobs. +addJob :: TMVar () -> JobResources -> JobResources +addJob job jobs@( Jobs { jobsWaiting = wait }) + = jobs { jobsWaiting = wait `SnocOL` job } + +-- | The state of the semaphore job server. +data JobserverState + = JobserverState + { jobserverAction :: !JobserverAction + -- ^ The current action being performed by the + -- job server. + , canChangeNumCaps :: !(TVar Bool) + -- ^ A TVar that signals whether it has been long + -- enough since we last changed 'numCapabilities'. + , canReleaseToken :: !(TVar Bool) + -- ^ A TVar that signals whether we last acquired + -- a token long enough ago that we can now release + -- a token. + } +data JobserverAction + -- | The jobserver is idle: no thread is currently + -- interacting with the semaphore. + = Idle + -- | A thread is waiting for a token on the semaphore. + | Acquiring + { activeWaitId :: WaitId + , threadFinished :: TMVar (Maybe MC.SomeException) } + +-- | Retrieve the 'TMVar' that signals if the current thread has finished, +-- if any thread is currently active in the jobserver. +activeThread_maybe :: JobserverAction -> Maybe (TMVar (Maybe MC.SomeException)) +activeThread_maybe Idle = Nothing +activeThread_maybe (Acquiring { threadFinished = tmvar }) = Just tmvar + +-- | Whether we should try to acquire a new token from the semaphore: +-- there is a pending job and no free tokens. +guardAcquire :: JobResources -> Bool +guardAcquire ( Jobs { tokensFree, jobsWaiting } ) + = tokensFree == 0 && not (null jobsWaiting) + +-- | Whether we should release a token from the semaphore: +-- there are no pending jobs and we can release a token. +guardRelease :: JobResources -> Bool +guardRelease ( Jobs { tokensFree, tokensOwned, jobsWaiting } ) + = null jobsWaiting && tokensFree > 0 && tokensOwned > 1 + +--------------------------------------- +-- Semaphore jobserver implementation + +-- | Add one pending job to the jobserver. +-- +-- Blocks, waiting on the jobserver to supply a free token. +acquireJob :: TVar JobResources -> IO () +acquireJob jobs_tvar = do + (job_tmvar, _jobs0) <- tracedAtomically "acquire" $ + modifyJobResources jobs_tvar \ jobs -> do + job_tmvar <- newEmptyTMVar + return ((job_tmvar, jobs), addJob job_tmvar jobs) + atomically $ takeTMVar job_tmvar + +-- | Signal to the job server that one job has completed, +-- releasing its corresponding token. +releaseJob :: TVar JobResources -> IO () +releaseJob jobs_tvar = do + tracedAtomically "release" do + modifyJobResources jobs_tvar \ jobs -> do + massertPpr (tokensFree jobs < tokensOwned jobs) + (text "releaseJob: more free jobs than owned jobs!") + return ((), addFreeToken jobs) + + +-- | Release all tokens owned from the semaphore (to clean up +-- the jobserver at the end). +cleanupJobserver :: Jobserver -> IO () +cleanupJobserver (Jobserver { jSemaphore = sem + , jobs = jobs_tvar }) + = do + Jobs { tokensOwned = owned } <- readTVarIO jobs_tvar + let toks_to_release = owned - 1 + -- Subtract off the implicit token: whoever spawned the ghc process + -- in the first place is responsible for that token. + releaseSemaphore sem toks_to_release + +-- | Dispatch the available tokens acquired from the semaphore +-- to the pending jobs in the job server. +dispatchTokens :: JobResources -> STM JobResources +dispatchTokens jobs@( Jobs { tokensFree = toks_free, jobsWaiting = wait } ) + | toks_free > 0 + , next `ConsOL` rest <- wait + -- There's a pending job and a free token: + -- pass on the token to that job, and recur. + = do + putTMVar next () + let jobs' = jobs { tokensFree = toks_free - 1, jobsWaiting = rest } + dispatchTokens jobs' + | otherwise + = return jobs + +-- | Update the available resources used from a semaphore, dispatching +-- any newly acquired resources. +-- +-- Invariant: if the number of available resources decreases, there +-- must be no pending jobs. +-- +-- All modifications should go through this function to ensure the contents +-- of the 'TVar' remains in normal form. +modifyJobResources :: HasCallStack => TVar JobResources + -> (JobResources -> STM (a, JobResources)) + -> STM (a, Maybe JobResources) +modifyJobResources jobs_tvar action = do + old_jobs <- readTVar jobs_tvar + (a, jobs) <- action old_jobs + + -- Check the invariant: if the number of free tokens has decreased, + -- there must be no pending jobs. + massertPpr (null (jobsWaiting jobs) || tokensFree jobs >= tokensFree old_jobs) $ + vcat [ text "modiyJobResources: pending jobs but fewer free tokens" ] + dispatched_jobs <- dispatchTokens jobs + writeTVar jobs_tvar dispatched_jobs + return (a, Just dispatched_jobs) + + +tracedAtomically_ :: String -> STM (Maybe JobResources) -> IO () +tracedAtomically_ s act = tracedAtomically s (((),) <$> act) + +tracedAtomically :: String -> STM (a, Maybe JobResources) -> IO a +tracedAtomically origin act = do + (a, mjr) <- atomically act + forM_ mjr $ \ jr -> do + -- Use the "jsem:" prefix to identify where the write traces are + traceEventIO ("jsem:" ++ renderJobResources origin jr) + return a + +renderJobResources :: String -> JobResources -> String +renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON $ + JSObject [ ("name", JSString origin) + , ("owned", JSInt own) + , ("free", JSInt free) + , ("pending", JSInt (length pending) ) + ] + + +-- | Spawn a new thread that waits on the semaphore in order to acquire +-- an additional token. +acquireThread :: Jobserver -> IO JobserverAction +acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + let + wait_result_action :: Either MC.SomeException Bool -> IO () + wait_result_action wait_res = + tracedAtomically_ "acquire_thread" do + (r, jb) <- case wait_res of + Left (e :: MC.SomeException) -> do + return $ (Just e, Nothing) + Right success -> do + if success + then do + modifyJobResources jobs_tvar \ jobs -> + return (Nothing, addToken jobs) + else + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jb + wait_id <- forkWaitOnSemaphoreInterruptible sem wait_result_action + labelThread (waitingThreadId wait_id) "acquire_thread" + return $ Acquiring { activeWaitId = wait_id + , threadFinished = threadFinished_tmvar } + +-- | Spawn a thread to release ownership of one resource from the semaphore, +-- provided we have spare resources and no pending jobs. +releaseThread :: Jobserver -> IO JobserverAction +releaseThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do + threadFinished_tmvar <- newEmptyTMVarIO + MC.mask_ do + -- Pre-release the resource so that another thread doesn't take control of it + -- just as we release the lock on the semaphore. + still_ok_to_release + <- tracedAtomically "pre_release" $ + modifyJobResources jobs_tvar \ jobs -> + if guardRelease jobs + -- TODO: should this also debounce? + then return (True , removeOwnedToken $ removeFreeToken jobs) + else return (False, jobs) + if not still_ok_to_release + then return Idle + else do + tid <- forkIO $ do + x <- MC.try $ releaseSemaphore sem 1 + tracedAtomically_ "post-release" $ do + (r, jobs) <- case x of + Left (e :: MC.SomeException) -> do + modifyJobResources jobs_tvar \ jobs -> + return (Just e, addToken jobs) + Right _ -> do + return (Nothing, Nothing) + putTMVar threadFinished_tmvar r + return jobs + labelThread tid "release_thread" + return Idle + +-- | When there are pending jobs but no free tokens, +-- spawn a thread to acquire a new token from the semaphore. +-- +-- See 'acquireThread'. +tryAcquire :: JobserverOptions + -> Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryAcquire opts js@( Jobserver { jobs = jobs_tvar }) + st@( JobserverState { jobserverAction = Idle } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardAcquire jobs + return do + action <- acquireThread js + -- Set a debounce after acquiring a token. + can_release_tvar <- registerDelay $ (releaseDebounce opts * 1000) + return $ st { jobserverAction = action + , canReleaseToken = can_release_tvar } +tryAcquire _ _ _ = retry + +-- | When there are free tokens and no pending jobs, +-- spawn a thread to release a token from the semamphore. +-- +-- See 'releaseThread'. +tryRelease :: Jobserver + -> JobserverState + -> STM (IO JobserverState) +tryRelease sjs@( Jobserver { jobs = jobs_tvar } ) + st@( JobserverState + { jobserverAction = Idle + , canReleaseToken = can_release_tvar } ) + = do + jobs <- readTVar jobs_tvar + guard $ guardRelease jobs + can_release <- readTVar can_release_tvar + guard can_release + return do + action <- releaseThread sjs + return $ st { jobserverAction = action } +tryRelease _ _ = retry + +-- | Wait for an active thread to finish. Once it finishes: +-- +-- - set the 'JobserverAction' to 'Idle', +-- - update the number of capabilities to reflect the number +-- of owned tokens from the semaphore. +tryNoticeIdle :: JobserverOptions + -> TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryNoticeIdle opts jobs_tvar jobserver_state + | Just threadFinished_tmvar <- activeThread_maybe $ jobserverAction jobserver_state + = sync_num_caps (canChangeNumCaps jobserver_state) threadFinished_tmvar + | otherwise + = retry -- no active thread: wait until jobserver isn't idle + where + sync_num_caps :: TVar Bool + -> TMVar (Maybe MC.SomeException) + -> STM (IO JobserverState) + sync_num_caps can_change_numcaps_tvar threadFinished_tmvar = do + mb_ex <- takeTMVar threadFinished_tmvar + for_ mb_ex MC.throwM + Jobs { tokensOwned } <- readTVar jobs_tvar + can_change_numcaps <- readTVar can_change_numcaps_tvar + guard can_change_numcaps + return do + x <- getNumCapabilities + can_change_numcaps_tvar_2 <- + if x == tokensOwned + then return can_change_numcaps_tvar + else do + setNumCapabilities tokensOwned + registerDelay $ (setNumCapsDebounce opts * 1000) + return $ + jobserver_state + { jobserverAction = Idle + , canChangeNumCaps = can_change_numcaps_tvar_2 } + +-- | Try to stop the current thread which is acquiring/releasing resources +-- if that operation is no longer relevant. +tryStopThread :: TVar JobResources + -> JobserverState + -> STM (IO JobserverState) +tryStopThread jobs_tvar jsj = do + case jobserverAction jsj of + Acquiring { activeWaitId = wait_id } -> do + jobs <- readTVar jobs_tvar + guard $ null (jobsWaiting jobs) + return do + interruptWaitOnSemaphore wait_id + return $ jsj { jobserverAction = Idle } + _ -> retry + +-- | Main jobserver loop: acquire/release resources as +-- needed for the pending jobs and available semaphore tokens. +jobserverLoop :: JobserverOptions -> Jobserver -> IO () +jobserverLoop opts sjs@(Jobserver { jobs = jobs_tvar }) + = do + true_tvar <- newTVarIO True + let init_state :: JobserverState + init_state = + JobserverState + { jobserverAction = Idle + , canChangeNumCaps = true_tvar + , canReleaseToken = true_tvar } + loop init_state + where + loop s = do + action <- atomically $ asum $ (\x -> x s) <$> + [ tryRelease sjs + , tryAcquire opts sjs + , tryNoticeIdle opts jobs_tvar + , tryStopThread jobs_tvar + ] + s <- action + loop s + +-- | Create a new jobserver using the given semaphore handle. +makeJobserver :: SemaphoreName -> IO (AbstractSem, IO ()) +makeJobserver sem_name = do + semaphore <- openSemaphore sem_name + let + init_jobs = + Jobs { tokensOwned = 1 + , tokensFree = 1 + , jobsWaiting = NilOL + } + jobs_tvar <- newTVarIO init_jobs + let + opts = defaultJobserverOptions -- TODO: allow this to be configured + sjs = Jobserver { jSemaphore = semaphore + , jobs = jobs_tvar } + loop_finished_mvar <- newEmptyMVar + loop_tid <- forkIOWithUnmask \ unmask -> do + r <- try $ unmask $ jobserverLoop opts sjs + putMVar loop_finished_mvar $ + case r of + Left e + | Just ThreadKilled <- fromException e + -> Nothing + | otherwise + -> Just e + Right () -> Nothing + labelThread loop_tid "job_server" + let + acquireSem = acquireJob jobs_tvar + releaseSem = releaseJob jobs_tvar + cleanupSem = do + -- this is interruptible + cleanupJobserver sjs + killThread loop_tid + mb_ex <- takeMVar loop_finished_mvar + for_ mb_ex MC.throwM + + return (AbstractSem{..}, cleanupSem) + +-- | Implement an abstract semaphore using a semaphore 'Jobserver' +-- which queries the system semaphore of the given name for resources. +runJSemAbstractSem :: SemaphoreName -- ^ the system semaphore to use + -> (AbstractSem -> IO a) -- ^ the operation to run + -- which requires a semaphore + -> IO a +runJSemAbstractSem sem action = MC.mask \ unmask -> do + (abs, cleanup) <- makeJobserver sem + r <- try $ unmask $ action abs + case r of + Left (e1 :: MC.SomeException) -> do + (_ :: Either MC.SomeException ()) <- MC.try cleanup + MC.throwM e1 + Right x -> cleanup $> x + +{- +Note [Architecture of the Job Server] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In `-jsem` mode, the amount of parallelism that GHC can use is controlled by a +system semaphore. We take resources from the semaphore when we need them, and +give them back if we don't have enough to do. + +A naive implementation would just take and release the semaphore around performing +the action, but this leads to two issues: + +* When taking a token in the semaphore, we must call `setNumCapabilities` in order + to adjust how many capabilities are available for parallel garbage collection. + This causes unnecessary synchronisations. +* We want to implement a debounce, so that whilst there is pending work in the + current process we prefer to keep hold of resources from the semaphore. + This reduces overall memory usage, as there are fewer live GHC processes at once. + +Therefore, the obtention of semaphore resources is separated away from the +request for the resource in the driver. + +A token from the semaphore is requested using `acquireJob`. This creates a pending +job, which is a MVar that can be filled in to signal that the requested token is ready. + +When the job is finished, the token is released by calling `releaseJob`, which just +increases the number of `free` jobs. If there are more pending jobs when the free count +is increased, the token is immediately reused (see `modifyJobResources`). + +The `jobServerLoop` interacts with the system semaphore: when there are pending +jobs, `acquireThread` blocks, waiting for a token from the semaphore. Once a +token is obtained, it increases the owned count. + +When GHC has free tokens (tokens from the semaphore that it is not using), +no pending jobs, and the debounce has expired, then `releaseThread` will +release tokens back to the global semaphore. + +`tryStopThread` attempts to kill threads which are waiting to acquire a resource +when we no longer need it. For example, consider that we attempt to acquire two +tokens, but the first job finishes before we acquire the second token. +This second token is no longer needed, so we should cancel the wait +(as it would not be used to do any work, and not be returned until the debounce). +We only need to kill `acquireJob`, because `releaseJob` never blocks. + +Note [Eventlog Messages for jsem] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +It can be tricky to verify that the work is shared adequately across different +processes. To help debug this, we output the values of `JobResource` to the +eventlog whenever the global state changes. There are some scripts which can be used +to analyse this output and report statistics about core saturation in the +GitHub repo (https://github.com/mpickering/ghc-jsem-analyse). + +-} ===================================== compiler/GHC/Driver/Pipeline/LogQueue.hs ===================================== @@ -100,10 +100,10 @@ dequeueLogQueueQueue (LogQueueQueue n lqq) = case IM.minViewWithKey lqq of Just ((k, v), lqq') | k == n -> Just (v, LogQueueQueue (n + 1) lqq') _ -> Nothing -logThread :: Int -> Int -> Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit +logThread :: Logger -> TVar Bool -- Signal that no more new logs will be added, clear the queue and exit -> TVar LogQueueQueue -- Queue for logs -> IO (IO ()) -logThread _ _ logger stopped lqq_var = do +logThread logger stopped lqq_var = do finished_var <- newEmptyMVar _ <- forkIO $ print_logs *> putMVar finished_var () return (takeMVar finished_var) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -43,6 +43,7 @@ module GHC.Driver.Session ( needSourceNotes, OnOff(..), DynFlags(..), + ParMakeCount(..), outputFile, objectSuf, ways, FlagSpec(..), HasDynFlags(..), ContainsDynFlags(..), @@ -461,9 +462,9 @@ data DynFlags = DynFlags { ruleCheck :: Maybe String, strictnessBefore :: [Int], -- ^ Additional demand analysis - parMakeCount :: Maybe Int, -- ^ The number of modules to compile in parallel - -- in --make mode, where Nothing ==> compile as - -- many in parallel as there are CPUs. + parMakeCount :: Maybe ParMakeCount, + -- ^ The number of modules to compile in parallel + -- If unspecified, compile with a single job. enableTimeStats :: Bool, -- ^ Enable RTS timing statistics? ghcHeapSize :: Maybe Int, -- ^ The heap size to set. @@ -783,6 +784,13 @@ instance (Monad m, HasDynFlags m) => HasDynFlags (ExceptT e m) where class ContainsDynFlags t where extractDynFlags :: t -> DynFlags +-- | The type for the -jN argument, specifying that -j on its own represents +-- using the number of machine processors. +data ParMakeCount + = ParMakeThisMany Int -- -j + | ParMakeSemaphore FilePath --jsem + | ParMakeNumProcessors -- -j + ----------------------------------------------------------------------------- -- Accessors from 'DynFlags' @@ -1146,7 +1154,7 @@ defaultDynFlags mySettings = historySize = 20, strictnessBefore = [], - parMakeCount = Just 1, + parMakeCount = Nothing, enableTimeStats = False, ghcHeapSize = Nothing, @@ -2066,14 +2074,16 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "j" (OptIntSuffix (\n -> case n of Just n - | n > 0 -> upd (\d -> d { parMakeCount = Just n }) + | n > 0 -> upd (\d -> d { parMakeCount = Just (ParMakeThisMany n) }) | otherwise -> addErr "Syntax: -j[n] where n > 0" - Nothing -> upd (\d -> d { parMakeCount = Nothing }))) + Nothing -> upd (\d -> d { parMakeCount = Just ParMakeNumProcessors }))) -- When the number of parallel builds -- is omitted, it is the same -- as specifying that the number of -- parallel builds is equal to the -- result of getNumProcessors + , make_ord_flag defGhcFlag "jsem" $ hasArg $ \f d -> d { parMakeCount = Just (ParMakeSemaphore f) } + , make_ord_flag defFlag "instantiated-with" (sepArg setUnitInstantiations) , make_ord_flag defFlag "this-component-id" (sepArg setUnitInstanceOf) ===================================== compiler/ghc.cabal.in ===================================== @@ -85,6 +85,7 @@ Library hpc == 0.6.*, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, + semaphore-compat, stm, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, @@ -436,6 +437,7 @@ Library GHC.Driver.GenerateCgIPEStub GHC.Driver.Hooks GHC.Driver.LlvmConfigCache + GHC.Driver.MakeSem GHC.Driver.Main GHC.Driver.Make GHC.Driver.MakeFile ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -35,6 +35,10 @@ Compiler - Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``. See GHC ticket #23049. +- GHC Proposal `#540 https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0540-jsem.rst`_ has been implemented. This adds the `-jsem`:ghc-flag: which instructs GHC to act + as a jobserver client when passed. This enables multiple GHC processes running + at once to share the system resources with each other via the system semaphore. + GHCi ~~~~ ===================================== docs/users_guide/using.rst ===================================== @@ -751,6 +751,61 @@ search path (see :ref:`search-path`). number of processors. Note that compilation of a module may not begin until its dependencies have been built. + +GHC Jobserver Protocol +~~~~~~~~~~~~~~~~~~~~~~ + +The GHC Jobserver Protocol was specified in `GHC proposal #540 `__. + +This protocol allows +a server to dynamically invoke many instances of a client process, +while restricting all of those instances to use no more than capabilities. +This is achieved by coordination over a system semaphore (either a POSIX +semaphore in the case of Linux and Darwin, or a Win32 semaphore +in the case of Windows platforms). + +There are two kinds of participants in the GHC Jobserver protocol: + +- The *jobserver* creates a system semaphore with a certain number of + available tokens. + + Each time the jobserver wants to spawn a new jobclient subprocess, it **must** + first acquire a single token from the semaphore, before spawning + the subprocess. This token **must** be released once the subprocess terminates. + + Once work is finished, the jobserver **must** destroy the semaphore it created. + +- A *jobclient* is a subprocess spawned by the jobserver or another jobclient. + + Each jobclient starts with one available token (its *implicit token*, + which was acquired by the parent which spawned it), and can request more + tokens through the Jobserver Protocol by waiting on the semaphore. + + Each time a jobclient wants to spawn a new jobclient subprocess, it **must** + pass on a single token to the child jobclient. This token can either be the + jobclient's implicit token, or another token which the jobclient acquired + from the semaphore. + + Each jobclient **must** release exactly as many tokens as it has acquired from + the semaphore (this does not include the implicit tokens). + + GHC itself acts as a jobclient which can be enabled by using the flag ``-jsem``. + +.. ghc-flag:: -jsem + :shortdesc: When compiling with :ghc-flag:`--make`, coordinate with + other processes through the semaphore ⟨sem⟩ to compile + modules in parallel. + :type: dynamic + :category: misc + + Perform compilation in parallel when possible, coordinating with other + processes through the semaphore ⟨sem⟩. + Error if the semaphore doesn't exist. + + Use of ``-jsem`` will override use of `-j[⟨n⟩]`:ghc-flag:. + + + .. _multi-home-units: Multiple Home Units ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -39,7 +39,7 @@ ghcPackages = , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl - , parsec, pretty, process, rts, runGhc, stm, templateHaskell + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon @@ -55,7 +55,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, - parsec, pretty, primitive, process, rts, runGhc, stm, templateHaskell, + parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace @@ -110,6 +110,7 @@ process = lib "process" remoteIserv = util "remote-iserv" rts = top "rts" runGhc = util "runghc" +semaphoreCompat = lib "semaphore-compat" stm = lib "stm" templateHaskell = lib "template-haskell" terminfo = lib "terminfo" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -171,6 +171,7 @@ toolTargets = [ binary , templateHaskell , text , transformers + , semaphoreCompat , unlit -- # executable ] ++ if windowsHost then [ win32 ] else [ unix ] ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -95,6 +95,7 @@ stage0Packages = do , hpcBin , mtl , parsec + , semaphoreCompat , time , templateHaskell , text @@ -142,6 +143,7 @@ stage1Packages = do , integerGmp , pretty , rts + , semaphoreCompat , stm , unlit , xhtml ===================================== libraries/semaphore-compat ===================================== @@ -0,0 +1 @@ +Subproject commit 663ef75467995acf41c51d3e21d03347e85b844e ===================================== packages ===================================== @@ -65,5 +65,6 @@ libraries/Win32 - - https:/ libraries/xhtml - - https://github.com/haskell/xhtml.git libraries/exceptions - - https://github.com/ekmett/exceptions.git nofib nofib - - +libraries/semaphore-compat - - - libraries/stm - - ssh://git at github.com/haskell/stm.git . - ghc.git - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f5dee7ae15a3c1213cf3e988a0041660a9ac882 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f5dee7ae15a3c1213cf3e988a0041660a9ac882 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 11:26:45 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Thu, 23 Mar 2023 07:26:45 -0400 Subject: [Git][ghc/ghc][wip/T23153] Handle ConcreteTvs in inferResultToType Message-ID: <641c37757a704_90da49c916cc8564ec@gitlab.mail> sheaf pushed to branch wip/T23153 at Glasgow Haskell Compiler / GHC Commits: 34f64de1 by sheaf at 2023-03-23T12:26:19+01:00 Handle ConcreteTvs in inferResultToType This patch fixes two issues. 1. inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. 2. startSolvingByUnification can make some type variables concrete. However, it didn't return an updated type, so callers of this function, if they don't zonk, might miss this and accidentally perform a double update of a metavariable. We now return the updated type from this function, which avoids this issue. Fixes #23154 - - - - - 10 changed files: - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Utils/Zonk.hs - + testsuite/tests/rep-poly/T23154.hs - + testsuite/tests/rep-poly/T23154.stderr - testsuite/tests/rep-poly/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -908,7 +908,7 @@ tcExprWithSig expr hs_ty loc = getLocA (dropWildCards hs_ty) ctxt = ExprSigCtxt (lhsSigWcTypeContextSpan hs_ty) -tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType) +tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcSigmaType) tcExprSig ctxt expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc }) = setSrcSpan loc $ -- Sets the location for the implication constraint do { let poly_ty = idType poly_id ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2172,7 +2172,7 @@ bindNamedWildCardBinders wc_names thing_inside newNamedWildTyVar :: Name -> TcM TcTyVar -- ^ New unification variable '_' for a wildcard -newNamedWildTyVar _name -- Currently ignoring the "_x" wildcard name used in the type +newNamedWildTyVar _wc_name -- Currently ignoring the "_x" wildcard name used in the type = do { kind <- newMetaKindVar ; details <- newMetaDetails TauTv ; wc_name <- newMetaTyVarName (fsLit "w") -- See Note [Wildcard names] ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1651,7 +1651,7 @@ canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) -> MCoercion -- :: kind(rhs) ~N kind(lhs) -> TcS (StopOrContinue Ct) canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco - = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv1 rhs + = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv1 rhs ; if | case is_touchable of { Untouchable -> False; _ -> True } , cterHasNoProblem $ checkTyVarEq tv1 rhs `cterRemoveProblem` cteTypeFamily @@ -2440,7 +2440,7 @@ tryToSolveByUnification tv ; dont_unify } | otherwise - = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv rhs + = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv rhs ; traceTcS "tryToSolveByUnification" (vcat [ ppr tv <+> char '~' <+> ppr rhs , ppr is_touchable ]) ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1326,35 +1326,37 @@ instance Outputable TouchabilityTestResult where ppr (TouchableOuterLevel tvs lvl) = text "TouchableOuterLevel" <> parens (ppr lvl <+> ppr tvs) ppr Untouchable = text "Untouchable" -touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS TouchabilityTestResult --- This is the key test for untouchability: +touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS (TouchabilityTestResult, TcType) +-- ^ This is the key test for untouchability: -- See Note [Unification preconditions] in GHC.Tc.Utils.Unify -- and Note [Solve by unification] in GHC.Tc.Solver.Interact +-- +-- Returns a new rhs type, as this function can turn make some metavariables concrete. touchabilityTest flav tv1 rhs | flav /= Given -- See Note [Do not unify Givens] , MetaTv { mtv_tclvl = tv_lvl, mtv_info = info } <- tcTyVarDetails tv1 - = do { can_continue_solving <- wrapTcS $ startSolvingByUnification info rhs - ; if not can_continue_solving - then return Untouchable - else - do { ambient_lvl <- getTcLevel + = do { continue_solving <- wrapTcS $ startSolvingByUnification info rhs + ; case continue_solving of + { Nothing -> return (Untouchable, rhs) + ; Just rhs -> + do { let (free_metas, free_skols) = partition isPromotableMetaTyVar $ + nonDetEltsUniqSet $ + tyCoVarsOfType rhs + ; ambient_lvl <- getTcLevel ; given_eq_lvl <- getInnermostGivenEqLevel ; if | tv_lvl `sameDepthAs` ambient_lvl - -> return TouchableSameLevel + -> return (TouchableSameLevel, rhs) | tv_lvl `deeperThanOrSame` given_eq_lvl -- No intervening given equalities , all (does_not_escape tv_lvl) free_skols -- No skolem escapes - -> return (TouchableOuterLevel free_metas tv_lvl) + -> return (TouchableOuterLevel free_metas tv_lvl, rhs) | otherwise - -> return Untouchable } } + -> return (Untouchable, rhs) } } } | otherwise - = return Untouchable + = return (Untouchable, rhs) where - (free_metas, free_skols) = partition isPromotableMetaTyVar $ - nonDetEltsUniqSet $ - tyCoVarsOfType rhs does_not_escape tv_lvl fv | isTyVar fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv @@ -2165,23 +2167,21 @@ breakTyEqCycle_maybe ev cte_result lhs rhs -- See Detail (8) of the Note. = do { should_break <- final_check - ; if should_break then do { redn <- go rhs - ; return (Just redn) } - else return Nothing } + ; mapM go should_break } where flavour = ctEvFlavour ev eq_rel = ctEvEqRel ev final_check = case flavour of - Given -> return True + Given -> return $ Just rhs Wanted -- Wanteds work only with a touchable tyvar on the left -- See "Wanted" section of the Note. | TyVarLHS lhs_tv <- lhs -> - do { result <- touchabilityTest Wanted lhs_tv rhs + do { (result, rhs) <- touchabilityTest Wanted lhs_tv rhs ; return $ case result of - Untouchable -> False - _ -> True } - | otherwise -> return False + Untouchable -> Nothing + _ -> Just rhs } + | otherwise -> return Nothing -- This could be considerably more efficient. See Detail (5) of Note. go :: TcType -> TcS ReductionN ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecursiveDo #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -536,20 +537,28 @@ expTypeToType (Infer inf_res) = inferResultToType inf_res inferResultToType :: InferResult -> TcM Type inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl - , ir_ref = ref }) + , ir_ref = ref + , ir_frr = mb_frr }) = do { mb_inferred_ty <- readTcRef ref ; tau <- case mb_inferred_ty of Just ty -> do { ensureMonoType ty -- See Note [inferResultToType] ; return ty } - Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy - ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) - -- See Note [TcLevel of ExpType] + Nothing -> do { tau <- new_meta ; writeMutVar ref (Just tau) ; return tau } ; traceTc "Forcing ExpType to be monomorphic:" (ppr u <+> text ":=" <+> ppr tau) ; return tau } + where + -- See Note [TcLevel of ExpType] + new_meta = case mb_frr of + Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy + ; newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) } + Just frr -> mdo { rr <- newConcreteTyVarAtLevel conc_orig tc_lvl runtimeRepTy + ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) + ; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr + ; return tau } {- Note [inferResultToType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -872,6 +881,13 @@ newTauTvDetailsAtLevel tclvl , mtv_ref = ref , mtv_tclvl = tclvl }) } +newConcreteTvDetailsAtLevel :: ConcreteTvOrigin -> TcLevel -> TcM TcTyVarDetails +newConcreteTvDetailsAtLevel conc_orig tclvl + = do { ref <- newMutVar Flexi + ; return (MetaTv { mtv_info = ConcreteTv conc_orig + , mtv_ref = ref + , mtv_tclvl = tclvl }) } + cloneMetaTyVar :: TcTyVar -> TcM TcTyVar cloneMetaTyVar tv = assert (isTcTyVar tv) $ @@ -917,7 +933,7 @@ isUnfilledMetaTyVar tv -------------------- -- Works with both type and kind variables -writeMetaTyVar :: TcTyVar -> TcType -> TcM () +writeMetaTyVar :: HasDebugCallStack => TcTyVar -> TcType -> TcM () -- Write into a currently-empty MetaTyVar writeMetaTyVar tyvar ty @@ -935,7 +951,7 @@ writeMetaTyVar tyvar ty = massertPpr False (text "Writing to non-meta tyvar" <+> ppr tyvar) -------------------- -writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM () +writeMetaTyVarRef :: HasDebugCallStack => TcTyVar -> TcRef MetaDetails -> TcType -> TcM () -- Here the tyvar is for error checking only; -- the ref cell must be for the same tyvar writeMetaTyVarRef tyvar ref ty @@ -1100,6 +1116,13 @@ newMetaTyVarTyAtLevel tc_lvl kind ; name <- newMetaTyVarName (fsLit "p") ; return (mkTyVarTy (mkTcTyVar name kind details)) } +newConcreteTyVarAtLevel :: ConcreteTvOrigin -> TcLevel -> TcKind -> TcM TcType +newConcreteTyVarAtLevel conc_orig tc_lvl kind + = do { details <- newConcreteTvDetailsAtLevel conc_orig tc_lvl + ; name <- newMetaTyVarName (fsLit "c") + ; return (mkTyVarTy (mkTcTyVar name kind details)) } + + {- ********************************************************************* * * Finding variables to quantify over @@ -2235,7 +2258,7 @@ a \/\a in the final result but all the occurrences of a will be zonked to () * * ********************************************************************* -} -promoteMetaTyVarTo :: TcLevel -> TcTyVar -> TcM Bool +promoteMetaTyVarTo :: HasDebugCallStack => TcLevel -> TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore -- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion @@ -2253,7 +2276,7 @@ promoteMetaTyVarTo tclvl tv = return False -- Returns whether or not *any* tyvar is defaulted -promoteTyVarSet :: TcTyVarSet -> TcM Bool +promoteTyVarSet :: HasDebugCallStack => TcTyVarSet -> TcM Bool promoteTyVarSet tvs = do { tclvl <- getTcLevel ; bools <- mapM (promoteMetaTyVarTo tclvl) $ ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2072,10 +2072,10 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles , cterHasNoProblem (checkTyVarEq tv1 ty2) -- See Note [Prevent unification with type families] - = do { can_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2 - ; if not can_continue_solving - then not_ok_so_defer - else + = do { mb_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2 + ; case mb_continue_solving of + { Nothing -> not_ok_so_defer + ; Just ty2 -> do { co_k <- uType KindLevel kind_origin (typeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) @@ -2089,9 +2089,9 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 then do { writeMetaTyVar tv1 ty2 ; return (mkNomReflCo ty2) } - else defer }} -- This cannot be solved now. See GHC.Tc.Solver.Canonical - -- Note [Equalities with incompatible kinds] for how - -- this will be dealt with in the solver + else defer }}} -- This cannot be solved now. See GHC.Tc.Solver.Canonical + -- Note [Equalities with incompatible kinds] for how + -- this will be dealt with in the solver | otherwise = not_ok_so_defer @@ -2111,39 +2111,38 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- | Checks (TYVAR-TV), (COERCION-HOLE) and (CONCRETE) of -- Note [Unification preconditions]; returns True if these conditions -- are satisfied. But see the Note for other preconditions, too. -startSolvingByUnification :: MetaInfo -> TcType -- zonked - -> TcM Bool +startSolvingByUnification :: MetaInfo -> TcType -- zonked + -> TcM (Maybe TcType) startSolvingByUnification _ xi | hasCoercionHoleTy xi -- (COERCION-HOLE) check - = return False + = return Nothing startSolvingByUnification info xi = case info of - CycleBreakerTv -> return False + CycleBreakerTv -> return Nothing ConcreteTv conc_orig -> - do { (_, not_conc_reasons) <- makeTypeConcrete conc_orig xi + do { (xi', not_conc_reasons) <- makeTypeConcrete conc_orig xi -- NB: makeTypeConcrete has the side-effect of turning -- some TauTvs into ConcreteTvs, e.g. -- alpha[conc] ~# TYPE (TupleRep '[ beta[tau], IntRep ]) -- will write `beta[tau] := beta[conc]`. -- - -- We don't need to track these unifications for the purposes - -- of constraint solving (e.g. updating tcs_unified or tcs_unif_lvl), - -- as they don't unlock any further progress. + -- We return the new type, so that callers of this function + -- aren't required to zonk. ; case not_conc_reasons of - [] -> return True - _ -> return False } + [] -> return $ Just xi' + _ -> return Nothing } TyVarTv -> case getTyVar_maybe xi of - Nothing -> return False + Nothing -> return Nothing Just tv -> case tcTyVarDetails tv of -- (TYVAR-TV) wrinkle - SkolemTv {} -> return True - RuntimeUnk -> return True + SkolemTv {} -> return $ Just xi + RuntimeUnk -> return $ Just xi MetaTv { mtv_info = info } -> case info of - TyVarTv -> return True - _ -> return False - _ -> return True + TyVarTv -> return $ Just xi + _ -> return Nothing + _ -> return $ Just xi swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool swapOverTyVars is_given tv1 tv2 ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -1738,7 +1738,7 @@ change. But in some cases it makes a HUGE difference: see test T9198 and #19668. So yes, it seems worth it. -} -zonkTyVarOcc :: ZonkEnv -> TcTyVar -> TcM Type +zonkTyVarOcc :: HasDebugCallStack => ZonkEnv -> TcTyVar -> TcM Type zonkTyVarOcc env@(ZonkEnv { ze_flexi = flexi , ze_tv_env = tv_env , ze_meta_tv_env = mtv_env_ref }) tv ===================================== testsuite/tests/rep-poly/T23154.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PartialTypeSignatures #-} + +module T23154 where + +import GHC.Exts + +f x = x :: (_ :: (TYPE (_ _))) ===================================== testsuite/tests/rep-poly/T23154.stderr ===================================== @@ -0,0 +1,15 @@ + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -117,3 +117,4 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T23051', normal, compile_fail, ['']) test('T23153', normal, compile_fail, ['']) +test('T23154', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34f64de18c1b5d94cf1c3d749e2189b120288c12 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34f64de18c1b5d94cf1c3d749e2189b120288c12 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 11:29:33 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Thu, 23 Mar 2023 07:29:33 -0400 Subject: [Git][ghc/ghc][wip/T23153] Handle ConcreteTvs in inferResultToType Message-ID: <641c381d4ea52_90da49c9169085688e@gitlab.mail> sheaf pushed to branch wip/T23153 at Glasgow Haskell Compiler / GHC Commits: 2b8bd946 by sheaf at 2023-03-23T12:29:22+01:00 Handle ConcreteTvs in inferResultToType This patch fixes two issues. 1. inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. 2. startSolvingByUnification can make some type variables concrete. However, it didn't return an updated type, so callers of this function, if they don't zonk, might miss this and accidentally perform a double update of a metavariable. We now return the updated type from this function, which avoids this issue. Fixes #23154 - - - - - 9 changed files: - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Utils/Zonk.hs - + testsuite/tests/rep-poly/T23154.hs - + testsuite/tests/rep-poly/T23154.stderr - testsuite/tests/rep-poly/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -908,7 +908,7 @@ tcExprWithSig expr hs_ty loc = getLocA (dropWildCards hs_ty) ctxt = ExprSigCtxt (lhsSigWcTypeContextSpan hs_ty) -tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType) +tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcSigmaType) tcExprSig ctxt expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc }) = setSrcSpan loc $ -- Sets the location for the implication constraint do { let poly_ty = idType poly_id ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1651,7 +1651,7 @@ canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) -> MCoercion -- :: kind(rhs) ~N kind(lhs) -> TcS (StopOrContinue Ct) canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco - = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv1 rhs + = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv1 rhs ; if | case is_touchable of { Untouchable -> False; _ -> True } , cterHasNoProblem $ checkTyVarEq tv1 rhs `cterRemoveProblem` cteTypeFamily @@ -2440,7 +2440,7 @@ tryToSolveByUnification tv ; dont_unify } | otherwise - = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv rhs + = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv rhs ; traceTcS "tryToSolveByUnification" (vcat [ ppr tv <+> char '~' <+> ppr rhs , ppr is_touchable ]) ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1326,35 +1326,37 @@ instance Outputable TouchabilityTestResult where ppr (TouchableOuterLevel tvs lvl) = text "TouchableOuterLevel" <> parens (ppr lvl <+> ppr tvs) ppr Untouchable = text "Untouchable" -touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS TouchabilityTestResult --- This is the key test for untouchability: +touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS (TouchabilityTestResult, TcType) +-- ^ This is the key test for untouchability: -- See Note [Unification preconditions] in GHC.Tc.Utils.Unify -- and Note [Solve by unification] in GHC.Tc.Solver.Interact +-- +-- Returns a new rhs type, as this function can turn make some metavariables concrete. touchabilityTest flav tv1 rhs | flav /= Given -- See Note [Do not unify Givens] , MetaTv { mtv_tclvl = tv_lvl, mtv_info = info } <- tcTyVarDetails tv1 - = do { can_continue_solving <- wrapTcS $ startSolvingByUnification info rhs - ; if not can_continue_solving - then return Untouchable - else - do { ambient_lvl <- getTcLevel + = do { continue_solving <- wrapTcS $ startSolvingByUnification info rhs + ; case continue_solving of + { Nothing -> return (Untouchable, rhs) + ; Just rhs -> + do { let (free_metas, free_skols) = partition isPromotableMetaTyVar $ + nonDetEltsUniqSet $ + tyCoVarsOfType rhs + ; ambient_lvl <- getTcLevel ; given_eq_lvl <- getInnermostGivenEqLevel ; if | tv_lvl `sameDepthAs` ambient_lvl - -> return TouchableSameLevel + -> return (TouchableSameLevel, rhs) | tv_lvl `deeperThanOrSame` given_eq_lvl -- No intervening given equalities , all (does_not_escape tv_lvl) free_skols -- No skolem escapes - -> return (TouchableOuterLevel free_metas tv_lvl) + -> return (TouchableOuterLevel free_metas tv_lvl, rhs) | otherwise - -> return Untouchable } } + -> return (Untouchable, rhs) } } } | otherwise - = return Untouchable + = return (Untouchable, rhs) where - (free_metas, free_skols) = partition isPromotableMetaTyVar $ - nonDetEltsUniqSet $ - tyCoVarsOfType rhs does_not_escape tv_lvl fv | isTyVar fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv @@ -2165,23 +2167,21 @@ breakTyEqCycle_maybe ev cte_result lhs rhs -- See Detail (8) of the Note. = do { should_break <- final_check - ; if should_break then do { redn <- go rhs - ; return (Just redn) } - else return Nothing } + ; mapM go should_break } where flavour = ctEvFlavour ev eq_rel = ctEvEqRel ev final_check = case flavour of - Given -> return True + Given -> return $ Just rhs Wanted -- Wanteds work only with a touchable tyvar on the left -- See "Wanted" section of the Note. | TyVarLHS lhs_tv <- lhs -> - do { result <- touchabilityTest Wanted lhs_tv rhs + do { (result, rhs) <- touchabilityTest Wanted lhs_tv rhs ; return $ case result of - Untouchable -> False - _ -> True } - | otherwise -> return False + Untouchable -> Nothing + _ -> Just rhs } + | otherwise -> return Nothing -- This could be considerably more efficient. See Detail (5) of Note. go :: TcType -> TcS ReductionN ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecursiveDo #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -536,20 +537,28 @@ expTypeToType (Infer inf_res) = inferResultToType inf_res inferResultToType :: InferResult -> TcM Type inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl - , ir_ref = ref }) + , ir_ref = ref + , ir_frr = mb_frr }) = do { mb_inferred_ty <- readTcRef ref ; tau <- case mb_inferred_ty of Just ty -> do { ensureMonoType ty -- See Note [inferResultToType] ; return ty } - Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy - ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) - -- See Note [TcLevel of ExpType] + Nothing -> do { tau <- new_meta ; writeMutVar ref (Just tau) ; return tau } ; traceTc "Forcing ExpType to be monomorphic:" (ppr u <+> text ":=" <+> ppr tau) ; return tau } + where + -- See Note [TcLevel of ExpType] + new_meta = case mb_frr of + Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy + ; newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) } + Just frr -> mdo { rr <- newConcreteTyVarAtLevel conc_orig tc_lvl runtimeRepTy + ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) + ; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr + ; return tau } {- Note [inferResultToType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -872,6 +881,13 @@ newTauTvDetailsAtLevel tclvl , mtv_ref = ref , mtv_tclvl = tclvl }) } +newConcreteTvDetailsAtLevel :: ConcreteTvOrigin -> TcLevel -> TcM TcTyVarDetails +newConcreteTvDetailsAtLevel conc_orig tclvl + = do { ref <- newMutVar Flexi + ; return (MetaTv { mtv_info = ConcreteTv conc_orig + , mtv_ref = ref + , mtv_tclvl = tclvl }) } + cloneMetaTyVar :: TcTyVar -> TcM TcTyVar cloneMetaTyVar tv = assert (isTcTyVar tv) $ @@ -917,7 +933,7 @@ isUnfilledMetaTyVar tv -------------------- -- Works with both type and kind variables -writeMetaTyVar :: TcTyVar -> TcType -> TcM () +writeMetaTyVar :: HasDebugCallStack => TcTyVar -> TcType -> TcM () -- Write into a currently-empty MetaTyVar writeMetaTyVar tyvar ty @@ -935,7 +951,7 @@ writeMetaTyVar tyvar ty = massertPpr False (text "Writing to non-meta tyvar" <+> ppr tyvar) -------------------- -writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM () +writeMetaTyVarRef :: HasDebugCallStack => TcTyVar -> TcRef MetaDetails -> TcType -> TcM () -- Here the tyvar is for error checking only; -- the ref cell must be for the same tyvar writeMetaTyVarRef tyvar ref ty @@ -1100,6 +1116,13 @@ newMetaTyVarTyAtLevel tc_lvl kind ; name <- newMetaTyVarName (fsLit "p") ; return (mkTyVarTy (mkTcTyVar name kind details)) } +newConcreteTyVarAtLevel :: ConcreteTvOrigin -> TcLevel -> TcKind -> TcM TcType +newConcreteTyVarAtLevel conc_orig tc_lvl kind + = do { details <- newConcreteTvDetailsAtLevel conc_orig tc_lvl + ; name <- newMetaTyVarName (fsLit "c") + ; return (mkTyVarTy (mkTcTyVar name kind details)) } + + {- ********************************************************************* * * Finding variables to quantify over @@ -2235,7 +2258,7 @@ a \/\a in the final result but all the occurrences of a will be zonked to () * * ********************************************************************* -} -promoteMetaTyVarTo :: TcLevel -> TcTyVar -> TcM Bool +promoteMetaTyVarTo :: HasDebugCallStack => TcLevel -> TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore -- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion @@ -2253,7 +2276,7 @@ promoteMetaTyVarTo tclvl tv = return False -- Returns whether or not *any* tyvar is defaulted -promoteTyVarSet :: TcTyVarSet -> TcM Bool +promoteTyVarSet :: HasDebugCallStack => TcTyVarSet -> TcM Bool promoteTyVarSet tvs = do { tclvl <- getTcLevel ; bools <- mapM (promoteMetaTyVarTo tclvl) $ ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2072,10 +2072,10 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles , cterHasNoProblem (checkTyVarEq tv1 ty2) -- See Note [Prevent unification with type families] - = do { can_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2 - ; if not can_continue_solving - then not_ok_so_defer - else + = do { mb_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2 + ; case mb_continue_solving of + { Nothing -> not_ok_so_defer + ; Just ty2 -> do { co_k <- uType KindLevel kind_origin (typeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) @@ -2089,9 +2089,9 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 then do { writeMetaTyVar tv1 ty2 ; return (mkNomReflCo ty2) } - else defer }} -- This cannot be solved now. See GHC.Tc.Solver.Canonical - -- Note [Equalities with incompatible kinds] for how - -- this will be dealt with in the solver + else defer }}} -- This cannot be solved now. See GHC.Tc.Solver.Canonical + -- Note [Equalities with incompatible kinds] for how + -- this will be dealt with in the solver | otherwise = not_ok_so_defer @@ -2111,39 +2111,38 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- | Checks (TYVAR-TV), (COERCION-HOLE) and (CONCRETE) of -- Note [Unification preconditions]; returns True if these conditions -- are satisfied. But see the Note for other preconditions, too. -startSolvingByUnification :: MetaInfo -> TcType -- zonked - -> TcM Bool +startSolvingByUnification :: MetaInfo -> TcType -- zonked + -> TcM (Maybe TcType) startSolvingByUnification _ xi | hasCoercionHoleTy xi -- (COERCION-HOLE) check - = return False + = return Nothing startSolvingByUnification info xi = case info of - CycleBreakerTv -> return False + CycleBreakerTv -> return Nothing ConcreteTv conc_orig -> - do { (_, not_conc_reasons) <- makeTypeConcrete conc_orig xi + do { (xi, not_conc_reasons) <- makeTypeConcrete conc_orig xi -- NB: makeTypeConcrete has the side-effect of turning -- some TauTvs into ConcreteTvs, e.g. -- alpha[conc] ~# TYPE (TupleRep '[ beta[tau], IntRep ]) -- will write `beta[tau] := beta[conc]`. -- - -- We don't need to track these unifications for the purposes - -- of constraint solving (e.g. updating tcs_unified or tcs_unif_lvl), - -- as they don't unlock any further progress. + -- We return the new type, so that callers of this function + -- aren't required to zonk. ; case not_conc_reasons of - [] -> return True - _ -> return False } + [] -> return $ Just xi + _ -> return Nothing } TyVarTv -> case getTyVar_maybe xi of - Nothing -> return False + Nothing -> return Nothing Just tv -> case tcTyVarDetails tv of -- (TYVAR-TV) wrinkle - SkolemTv {} -> return True - RuntimeUnk -> return True + SkolemTv {} -> return $ Just xi + RuntimeUnk -> return $ Just xi MetaTv { mtv_info = info } -> case info of - TyVarTv -> return True - _ -> return False - _ -> return True + TyVarTv -> return $ Just xi + _ -> return Nothing + _ -> return $ Just xi swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool swapOverTyVars is_given tv1 tv2 ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -1738,7 +1738,7 @@ change. But in some cases it makes a HUGE difference: see test T9198 and #19668. So yes, it seems worth it. -} -zonkTyVarOcc :: ZonkEnv -> TcTyVar -> TcM Type +zonkTyVarOcc :: HasDebugCallStack => ZonkEnv -> TcTyVar -> TcM Type zonkTyVarOcc env@(ZonkEnv { ze_flexi = flexi , ze_tv_env = tv_env , ze_meta_tv_env = mtv_env_ref }) tv ===================================== testsuite/tests/rep-poly/T23154.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PartialTypeSignatures #-} + +module T23154 where + +import GHC.Exts + +f x = x :: (_ :: (TYPE (_ _))) ===================================== testsuite/tests/rep-poly/T23154.stderr ===================================== @@ -0,0 +1,15 @@ + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -117,3 +117,4 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T23051', normal, compile_fail, ['']) test('T23153', normal, compile_fail, ['']) +test('T23154', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b8bd94694a9e1b8475f2a136c997181b4e4bfc1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b8bd94694a9e1b8475f2a136c997181b4e4bfc1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 12:54:56 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Thu, 23 Mar 2023 08:54:56 -0400 Subject: [Git][ghc/ghc][wip/amg/warning-categories] 2 commits: Allow WARNING pragmas to be controlled with custom categories Message-ID: <641c4c202496b_90da4b771280885368@gitlab.mail> sheaf pushed to branch wip/amg/warning-categories at Glasgow Haskell Compiler / GHC Commits: c86b68d8 by Adam Gundry at 2023-03-23T13:54:35+01:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 01f9e3a6 by Adam Gundry at 2023-03-23T13:54:35+01:00 Move mention of warning groups change to 9.8.1 release notes - - - - - 30 changed files: - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/using-warnings.rst - testsuite/tests/parser/should_compile/T3303.stderr - testsuite/tests/rename/should_compile/T5867.stderr - testsuite/tests/rename/should_compile/rn050.stderr - testsuite/tests/rename/should_compile/rn066.stderr - testsuite/tests/rename/should_fail/T5281.stderr - testsuite/tests/warnings/should_compile/DeprU.stderr - + testsuite/tests/warnings/should_fail/WarningCategory1.hs - + testsuite/tests/warnings/should_fail/WarningCategory1.stderr - + testsuite/tests/warnings/should_fail/WarningCategory1_B.hs - + testsuite/tests/warnings/should_fail/WarningCategory2.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/07e0a5cadb9daad97815ba587b7a105925c978fc...01f9e3a6040e1cb5fe21962d5a425ca2c98dc8fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/07e0a5cadb9daad97815ba587b7a105925c978fc...01f9e3a6040e1cb5fe21962d5a425ca2c98dc8fa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 13:12:18 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Thu, 23 Mar 2023 09:12:18 -0400 Subject: [Git][ghc/ghc][wip/T23153] Handle ConcreteTvs in inferResultToType Message-ID: <641c503235bf5_90da4bbe19f089335a@gitlab.mail> sheaf pushed to branch wip/T23153 at Glasgow Haskell Compiler / GHC Commits: 01deaf26 by sheaf at 2023-03-23T14:12:05+01:00 Handle ConcreteTvs in inferResultToType This patch fixes two issues. 1. inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. 2. startSolvingByUnification can make some type variables concrete. However, it didn't return an updated type, so callers of this function, if they don't zonk, might miss this and accidentally perform a double update of a metavariable. We now return the updated type from this function, which avoids this issue. Fixes #23154 - - - - - 10 changed files: - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Utils/Zonk.hs - testsuite/tests/rep-poly/RepPolyPatBind.stderr - + testsuite/tests/rep-poly/T23154.hs - + testsuite/tests/rep-poly/T23154.stderr - testsuite/tests/rep-poly/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -908,7 +908,7 @@ tcExprWithSig expr hs_ty loc = getLocA (dropWildCards hs_ty) ctxt = ExprSigCtxt (lhsSigWcTypeContextSpan hs_ty) -tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType) +tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcSigmaType) tcExprSig ctxt expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc }) = setSrcSpan loc $ -- Sets the location for the implication constraint do { let poly_ty = idType poly_id ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1651,7 +1651,7 @@ canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) -> MCoercion -- :: kind(rhs) ~N kind(lhs) -> TcS (StopOrContinue Ct) canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco - = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv1 rhs + = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv1 rhs ; if | case is_touchable of { Untouchable -> False; _ -> True } , cterHasNoProblem $ checkTyVarEq tv1 rhs `cterRemoveProblem` cteTypeFamily @@ -2440,7 +2440,7 @@ tryToSolveByUnification tv ; dont_unify } | otherwise - = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv rhs + = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv rhs ; traceTcS "tryToSolveByUnification" (vcat [ ppr tv <+> char '~' <+> ppr rhs , ppr is_touchable ]) ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1326,35 +1326,37 @@ instance Outputable TouchabilityTestResult where ppr (TouchableOuterLevel tvs lvl) = text "TouchableOuterLevel" <> parens (ppr lvl <+> ppr tvs) ppr Untouchable = text "Untouchable" -touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS TouchabilityTestResult --- This is the key test for untouchability: +touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS (TouchabilityTestResult, TcType) +-- ^ This is the key test for untouchability: -- See Note [Unification preconditions] in GHC.Tc.Utils.Unify -- and Note [Solve by unification] in GHC.Tc.Solver.Interact +-- +-- Returns a new rhs type, as this function can turn make some metavariables concrete. touchabilityTest flav tv1 rhs | flav /= Given -- See Note [Do not unify Givens] , MetaTv { mtv_tclvl = tv_lvl, mtv_info = info } <- tcTyVarDetails tv1 - = do { can_continue_solving <- wrapTcS $ startSolvingByUnification info rhs - ; if not can_continue_solving - then return Untouchable - else - do { ambient_lvl <- getTcLevel + = do { continue_solving <- wrapTcS $ startSolvingByUnification info rhs + ; case continue_solving of + { Nothing -> return (Untouchable, rhs) + ; Just rhs -> + do { let (free_metas, free_skols) = partition isPromotableMetaTyVar $ + nonDetEltsUniqSet $ + tyCoVarsOfType rhs + ; ambient_lvl <- getTcLevel ; given_eq_lvl <- getInnermostGivenEqLevel ; if | tv_lvl `sameDepthAs` ambient_lvl - -> return TouchableSameLevel + -> return (TouchableSameLevel, rhs) | tv_lvl `deeperThanOrSame` given_eq_lvl -- No intervening given equalities , all (does_not_escape tv_lvl) free_skols -- No skolem escapes - -> return (TouchableOuterLevel free_metas tv_lvl) + -> return (TouchableOuterLevel free_metas tv_lvl, rhs) | otherwise - -> return Untouchable } } + -> return (Untouchable, rhs) } } } | otherwise - = return Untouchable + = return (Untouchable, rhs) where - (free_metas, free_skols) = partition isPromotableMetaTyVar $ - nonDetEltsUniqSet $ - tyCoVarsOfType rhs does_not_escape tv_lvl fv | isTyVar fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv @@ -2165,23 +2167,21 @@ breakTyEqCycle_maybe ev cte_result lhs rhs -- See Detail (8) of the Note. = do { should_break <- final_check - ; if should_break then do { redn <- go rhs - ; return (Just redn) } - else return Nothing } + ; mapM go should_break } where flavour = ctEvFlavour ev eq_rel = ctEvEqRel ev final_check = case flavour of - Given -> return True + Given -> return $ Just rhs Wanted -- Wanteds work only with a touchable tyvar on the left -- See "Wanted" section of the Note. | TyVarLHS lhs_tv <- lhs -> - do { result <- touchabilityTest Wanted lhs_tv rhs + do { (result, rhs) <- touchabilityTest Wanted lhs_tv rhs ; return $ case result of - Untouchable -> False - _ -> True } - | otherwise -> return False + Untouchable -> Nothing + _ -> Just rhs } + | otherwise -> return Nothing -- This could be considerably more efficient. See Detail (5) of Note. go :: TcType -> TcS ReductionN ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecursiveDo #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -480,7 +481,16 @@ newInferExpType :: TcM ExpType newInferExpType = new_inferExpType Nothing newInferExpTypeFRR :: FixedRuntimeRepContext -> TcM ExpTypeFRR -newInferExpTypeFRR frr_orig = new_inferExpType (Just frr_orig) +newInferExpTypeFRR frr_orig + = do { th_stage <- getStage + ; if + -- See [Wrinkle: Typed Template Haskell] + -- in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. + | Brack _ (TcPending {}) <- th_stage + -> new_inferExpType Nothing + + | otherwise + -> new_inferExpType (Just frr_orig) } new_inferExpType :: Maybe FixedRuntimeRepContext -> TcM ExpType new_inferExpType mb_frr_orig @@ -536,20 +546,28 @@ expTypeToType (Infer inf_res) = inferResultToType inf_res inferResultToType :: InferResult -> TcM Type inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl - , ir_ref = ref }) + , ir_ref = ref + , ir_frr = mb_frr }) = do { mb_inferred_ty <- readTcRef ref ; tau <- case mb_inferred_ty of Just ty -> do { ensureMonoType ty -- See Note [inferResultToType] ; return ty } - Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy - ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) - -- See Note [TcLevel of ExpType] + Nothing -> do { tau <- new_meta ; writeMutVar ref (Just tau) ; return tau } ; traceTc "Forcing ExpType to be monomorphic:" (ppr u <+> text ":=" <+> ppr tau) ; return tau } + where + -- See Note [TcLevel of ExpType] + new_meta = case mb_frr of + Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy + ; newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) } + Just frr -> mdo { rr <- newConcreteTyVarAtLevel conc_orig tc_lvl runtimeRepTy + ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) + ; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr + ; return tau } {- Note [inferResultToType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -872,6 +890,13 @@ newTauTvDetailsAtLevel tclvl , mtv_ref = ref , mtv_tclvl = tclvl }) } +newConcreteTvDetailsAtLevel :: ConcreteTvOrigin -> TcLevel -> TcM TcTyVarDetails +newConcreteTvDetailsAtLevel conc_orig tclvl + = do { ref <- newMutVar Flexi + ; return (MetaTv { mtv_info = ConcreteTv conc_orig + , mtv_ref = ref + , mtv_tclvl = tclvl }) } + cloneMetaTyVar :: TcTyVar -> TcM TcTyVar cloneMetaTyVar tv = assert (isTcTyVar tv) $ @@ -917,7 +942,7 @@ isUnfilledMetaTyVar tv -------------------- -- Works with both type and kind variables -writeMetaTyVar :: TcTyVar -> TcType -> TcM () +writeMetaTyVar :: HasDebugCallStack => TcTyVar -> TcType -> TcM () -- Write into a currently-empty MetaTyVar writeMetaTyVar tyvar ty @@ -935,7 +960,7 @@ writeMetaTyVar tyvar ty = massertPpr False (text "Writing to non-meta tyvar" <+> ppr tyvar) -------------------- -writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM () +writeMetaTyVarRef :: HasDebugCallStack => TcTyVar -> TcRef MetaDetails -> TcType -> TcM () -- Here the tyvar is for error checking only; -- the ref cell must be for the same tyvar writeMetaTyVarRef tyvar ref ty @@ -1100,6 +1125,13 @@ newMetaTyVarTyAtLevel tc_lvl kind ; name <- newMetaTyVarName (fsLit "p") ; return (mkTyVarTy (mkTcTyVar name kind details)) } +newConcreteTyVarAtLevel :: ConcreteTvOrigin -> TcLevel -> TcKind -> TcM TcType +newConcreteTyVarAtLevel conc_orig tc_lvl kind + = do { details <- newConcreteTvDetailsAtLevel conc_orig tc_lvl + ; name <- newMetaTyVarName (fsLit "c") + ; return (mkTyVarTy (mkTcTyVar name kind details)) } + + {- ********************************************************************* * * Finding variables to quantify over @@ -2235,7 +2267,7 @@ a \/\a in the final result but all the occurrences of a will be zonked to () * * ********************************************************************* -} -promoteMetaTyVarTo :: TcLevel -> TcTyVar -> TcM Bool +promoteMetaTyVarTo :: HasDebugCallStack => TcLevel -> TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore -- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion @@ -2253,7 +2285,7 @@ promoteMetaTyVarTo tclvl tv = return False -- Returns whether or not *any* tyvar is defaulted -promoteTyVarSet :: TcTyVarSet -> TcM Bool +promoteTyVarSet :: HasDebugCallStack => TcTyVarSet -> TcM Bool promoteTyVarSet tvs = do { tclvl <- getTcLevel ; bools <- mapM (promoteMetaTyVarTo tclvl) $ ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2072,10 +2072,10 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles , cterHasNoProblem (checkTyVarEq tv1 ty2) -- See Note [Prevent unification with type families] - = do { can_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2 - ; if not can_continue_solving - then not_ok_so_defer - else + = do { mb_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2 + ; case mb_continue_solving of + { Nothing -> not_ok_so_defer + ; Just ty2 -> do { co_k <- uType KindLevel kind_origin (typeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) @@ -2089,9 +2089,9 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 then do { writeMetaTyVar tv1 ty2 ; return (mkNomReflCo ty2) } - else defer }} -- This cannot be solved now. See GHC.Tc.Solver.Canonical - -- Note [Equalities with incompatible kinds] for how - -- this will be dealt with in the solver + else defer }}} -- This cannot be solved now. See GHC.Tc.Solver.Canonical + -- Note [Equalities with incompatible kinds] for how + -- this will be dealt with in the solver | otherwise = not_ok_so_defer @@ -2111,39 +2111,38 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- | Checks (TYVAR-TV), (COERCION-HOLE) and (CONCRETE) of -- Note [Unification preconditions]; returns True if these conditions -- are satisfied. But see the Note for other preconditions, too. -startSolvingByUnification :: MetaInfo -> TcType -- zonked - -> TcM Bool +startSolvingByUnification :: MetaInfo -> TcType -- zonked + -> TcM (Maybe TcType) startSolvingByUnification _ xi | hasCoercionHoleTy xi -- (COERCION-HOLE) check - = return False + = return Nothing startSolvingByUnification info xi = case info of - CycleBreakerTv -> return False + CycleBreakerTv -> return Nothing ConcreteTv conc_orig -> - do { (_, not_conc_reasons) <- makeTypeConcrete conc_orig xi + do { (xi, not_conc_reasons) <- makeTypeConcrete conc_orig xi -- NB: makeTypeConcrete has the side-effect of turning -- some TauTvs into ConcreteTvs, e.g. -- alpha[conc] ~# TYPE (TupleRep '[ beta[tau], IntRep ]) -- will write `beta[tau] := beta[conc]`. -- - -- We don't need to track these unifications for the purposes - -- of constraint solving (e.g. updating tcs_unified or tcs_unif_lvl), - -- as they don't unlock any further progress. + -- We return the new type, so that callers of this function + -- aren't required to zonk. ; case not_conc_reasons of - [] -> return True - _ -> return False } + [] -> return $ Just xi + _ -> return Nothing } TyVarTv -> case getTyVar_maybe xi of - Nothing -> return False + Nothing -> return Nothing Just tv -> case tcTyVarDetails tv of -- (TYVAR-TV) wrinkle - SkolemTv {} -> return True - RuntimeUnk -> return True + SkolemTv {} -> return $ Just xi + RuntimeUnk -> return $ Just xi MetaTv { mtv_info = info } -> case info of - TyVarTv -> return True - _ -> return False - _ -> return True + TyVarTv -> return $ Just xi + _ -> return Nothing + _ -> return $ Just xi swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool swapOverTyVars is_given tv1 tv2 ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -1738,7 +1738,7 @@ change. But in some cases it makes a HUGE difference: see test T9198 and #19668. So yes, it seems worth it. -} -zonkTyVarOcc :: ZonkEnv -> TcTyVar -> TcM Type +zonkTyVarOcc :: HasDebugCallStack => ZonkEnv -> TcTyVar -> TcM Type zonkTyVarOcc env@(ZonkEnv { ze_flexi = flexi , ze_tv_env = tv_env , ze_meta_tv_env = mtv_env_ref }) tv ===================================== testsuite/tests/rep-poly/RepPolyPatBind.stderr ===================================== @@ -17,3 +17,36 @@ RepPolyPatBind.hs:18:5: error: [GHC-55287] x, y :: a (# x, y #) = undefined in x + +RepPolyPatBind.hs:18:8: error: [GHC-55287] + • The pattern binding does not have a fixed runtime representation. + Its type is: + (# a0, b0 #) :: TYPE (TupleRep [k00, k10]) + Cannot unify ‘rep’ with the type variable ‘k00’ + because it is not a concrete ‘RuntimeRep’. + • In the pattern: (# x, y #) + In a pattern binding: (# x, y #) = undefined + In the expression: + let + x, y :: a + (# x, y #) = undefined + in x + • Relevant bindings include + foo :: () -> a (bound at RepPolyPatBind.hs:15:1) + +RepPolyPatBind.hs:18:11: error: [GHC-55287] + • The pattern binding does not have a fixed runtime representation. + Its type is: + (# a0, b0 #) :: TYPE (TupleRep [k00, k10]) + Cannot unify ‘rep’ with the type variable ‘k10’ + because it is not a concrete ‘RuntimeRep’. + • In the pattern: (# x, y #) + In a pattern binding: (# x, y #) = undefined + In the expression: + let + x, y :: a + (# x, y #) = undefined + in x + • Relevant bindings include + x :: a (bound at RepPolyPatBind.hs:18:8) + foo :: () -> a (bound at RepPolyPatBind.hs:15:1) ===================================== testsuite/tests/rep-poly/T23154.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PartialTypeSignatures #-} + +module T23154 where + +import GHC.Exts + +f x = x :: (_ :: (TYPE (_ _))) ===================================== testsuite/tests/rep-poly/T23154.stderr ===================================== @@ -0,0 +1,15 @@ + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -117,3 +117,4 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T23051', normal, compile_fail, ['']) test('T23153', normal, compile_fail, ['']) +test('T23154', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01deaf2646a72a76629301233488b0425f5b7f2f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01deaf2646a72a76629301233488b0425f5b7f2f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 13:17:56 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 23 Mar 2023 09:17:56 -0400 Subject: [Git][ghc/ghc][wip/T23153] Handle ConcreteTvs in inferResultToType Message-ID: <641c5184d0ae6_90da4b846f84895831@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23153 at Glasgow Haskell Compiler / GHC Commits: 307ca52b by sheaf at 2023-03-23T14:16:11+01:00 Handle ConcreteTvs in inferResultToType This patch fixes two issues. 1. inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. 2. startSolvingByUnification can make some type variables concrete. However, it didn't return an updated type, so callers of this function, if they don't zonk, might miss this and accidentally perform a double update of a metavariable. We now return the updated type from this function, which avoids this issue. Fixes #23154 - - - - - 11 changed files: - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Utils/Zonk.hs - testsuite/tests/rep-poly/RepPolyPatBind.stderr - + testsuite/tests/rep-poly/T23154.hs - + testsuite/tests/rep-poly/T23154.stderr - testsuite/tests/rep-poly/all.T - testsuite/tests/typecheck/should_fail/VtaFail.stderr Changes: ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -908,7 +908,7 @@ tcExprWithSig expr hs_ty loc = getLocA (dropWildCards hs_ty) ctxt = ExprSigCtxt (lhsSigWcTypeContextSpan hs_ty) -tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType) +tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcSigmaType) tcExprSig ctxt expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc }) = setSrcSpan loc $ -- Sets the location for the implication constraint do { let poly_ty = idType poly_id ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1651,7 +1651,7 @@ canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) -> MCoercion -- :: kind(rhs) ~N kind(lhs) -> TcS (StopOrContinue Ct) canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco - = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv1 rhs + = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv1 rhs ; if | case is_touchable of { Untouchable -> False; _ -> True } , cterHasNoProblem $ checkTyVarEq tv1 rhs `cterRemoveProblem` cteTypeFamily @@ -2440,7 +2440,7 @@ tryToSolveByUnification tv ; dont_unify } | otherwise - = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv rhs + = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv rhs ; traceTcS "tryToSolveByUnification" (vcat [ ppr tv <+> char '~' <+> ppr rhs , ppr is_touchable ]) ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1326,35 +1326,37 @@ instance Outputable TouchabilityTestResult where ppr (TouchableOuterLevel tvs lvl) = text "TouchableOuterLevel" <> parens (ppr lvl <+> ppr tvs) ppr Untouchable = text "Untouchable" -touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS TouchabilityTestResult --- This is the key test for untouchability: +touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS (TouchabilityTestResult, TcType) +-- ^ This is the key test for untouchability: -- See Note [Unification preconditions] in GHC.Tc.Utils.Unify -- and Note [Solve by unification] in GHC.Tc.Solver.Interact +-- +-- Returns a new rhs type, as this function can turn make some metavariables concrete. touchabilityTest flav tv1 rhs | flav /= Given -- See Note [Do not unify Givens] , MetaTv { mtv_tclvl = tv_lvl, mtv_info = info } <- tcTyVarDetails tv1 - = do { can_continue_solving <- wrapTcS $ startSolvingByUnification info rhs - ; if not can_continue_solving - then return Untouchable - else - do { ambient_lvl <- getTcLevel + = do { continue_solving <- wrapTcS $ startSolvingByUnification info rhs + ; case continue_solving of + { Nothing -> return (Untouchable, rhs) + ; Just rhs -> + do { let (free_metas, free_skols) = partition isPromotableMetaTyVar $ + nonDetEltsUniqSet $ + tyCoVarsOfType rhs + ; ambient_lvl <- getTcLevel ; given_eq_lvl <- getInnermostGivenEqLevel ; if | tv_lvl `sameDepthAs` ambient_lvl - -> return TouchableSameLevel + -> return (TouchableSameLevel, rhs) | tv_lvl `deeperThanOrSame` given_eq_lvl -- No intervening given equalities , all (does_not_escape tv_lvl) free_skols -- No skolem escapes - -> return (TouchableOuterLevel free_metas tv_lvl) + -> return (TouchableOuterLevel free_metas tv_lvl, rhs) | otherwise - -> return Untouchable } } + -> return (Untouchable, rhs) } } } | otherwise - = return Untouchable + = return (Untouchable, rhs) where - (free_metas, free_skols) = partition isPromotableMetaTyVar $ - nonDetEltsUniqSet $ - tyCoVarsOfType rhs does_not_escape tv_lvl fv | isTyVar fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv @@ -2165,23 +2167,21 @@ breakTyEqCycle_maybe ev cte_result lhs rhs -- See Detail (8) of the Note. = do { should_break <- final_check - ; if should_break then do { redn <- go rhs - ; return (Just redn) } - else return Nothing } + ; mapM go should_break } where flavour = ctEvFlavour ev eq_rel = ctEvEqRel ev final_check = case flavour of - Given -> return True + Given -> return $ Just rhs Wanted -- Wanteds work only with a touchable tyvar on the left -- See "Wanted" section of the Note. | TyVarLHS lhs_tv <- lhs -> - do { result <- touchabilityTest Wanted lhs_tv rhs + do { (result, rhs) <- touchabilityTest Wanted lhs_tv rhs ; return $ case result of - Untouchable -> False - _ -> True } - | otherwise -> return False + Untouchable -> Nothing + _ -> Just rhs } + | otherwise -> return Nothing -- This could be considerably more efficient. See Detail (5) of Note. go :: TcType -> TcS ReductionN ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecursiveDo #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -480,7 +481,16 @@ newInferExpType :: TcM ExpType newInferExpType = new_inferExpType Nothing newInferExpTypeFRR :: FixedRuntimeRepContext -> TcM ExpTypeFRR -newInferExpTypeFRR frr_orig = new_inferExpType (Just frr_orig) +newInferExpTypeFRR frr_orig + = do { th_stage <- getStage + ; if + -- See [Wrinkle: Typed Template Haskell] + -- in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. + | Brack _ (TcPending {}) <- th_stage + -> new_inferExpType Nothing + + | otherwise + -> new_inferExpType (Just frr_orig) } new_inferExpType :: Maybe FixedRuntimeRepContext -> TcM ExpType new_inferExpType mb_frr_orig @@ -536,20 +546,28 @@ expTypeToType (Infer inf_res) = inferResultToType inf_res inferResultToType :: InferResult -> TcM Type inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl - , ir_ref = ref }) + , ir_ref = ref + , ir_frr = mb_frr }) = do { mb_inferred_ty <- readTcRef ref ; tau <- case mb_inferred_ty of Just ty -> do { ensureMonoType ty -- See Note [inferResultToType] ; return ty } - Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy - ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) - -- See Note [TcLevel of ExpType] + Nothing -> do { tau <- new_meta ; writeMutVar ref (Just tau) ; return tau } ; traceTc "Forcing ExpType to be monomorphic:" (ppr u <+> text ":=" <+> ppr tau) ; return tau } + where + -- See Note [TcLevel of ExpType] + new_meta = case mb_frr of + Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy + ; newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) } + Just frr -> mdo { rr <- newConcreteTyVarAtLevel conc_orig tc_lvl runtimeRepTy + ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) + ; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr + ; return tau } {- Note [inferResultToType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -872,6 +890,13 @@ newTauTvDetailsAtLevel tclvl , mtv_ref = ref , mtv_tclvl = tclvl }) } +newConcreteTvDetailsAtLevel :: ConcreteTvOrigin -> TcLevel -> TcM TcTyVarDetails +newConcreteTvDetailsAtLevel conc_orig tclvl + = do { ref <- newMutVar Flexi + ; return (MetaTv { mtv_info = ConcreteTv conc_orig + , mtv_ref = ref + , mtv_tclvl = tclvl }) } + cloneMetaTyVar :: TcTyVar -> TcM TcTyVar cloneMetaTyVar tv = assert (isTcTyVar tv) $ @@ -917,7 +942,7 @@ isUnfilledMetaTyVar tv -------------------- -- Works with both type and kind variables -writeMetaTyVar :: TcTyVar -> TcType -> TcM () +writeMetaTyVar :: HasDebugCallStack => TcTyVar -> TcType -> TcM () -- Write into a currently-empty MetaTyVar writeMetaTyVar tyvar ty @@ -935,7 +960,7 @@ writeMetaTyVar tyvar ty = massertPpr False (text "Writing to non-meta tyvar" <+> ppr tyvar) -------------------- -writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM () +writeMetaTyVarRef :: HasDebugCallStack => TcTyVar -> TcRef MetaDetails -> TcType -> TcM () -- Here the tyvar is for error checking only; -- the ref cell must be for the same tyvar writeMetaTyVarRef tyvar ref ty @@ -1100,6 +1125,13 @@ newMetaTyVarTyAtLevel tc_lvl kind ; name <- newMetaTyVarName (fsLit "p") ; return (mkTyVarTy (mkTcTyVar name kind details)) } +newConcreteTyVarAtLevel :: ConcreteTvOrigin -> TcLevel -> TcKind -> TcM TcType +newConcreteTyVarAtLevel conc_orig tc_lvl kind + = do { details <- newConcreteTvDetailsAtLevel conc_orig tc_lvl + ; name <- newMetaTyVarName (fsLit "c") + ; return (mkTyVarTy (mkTcTyVar name kind details)) } + + {- ********************************************************************* * * Finding variables to quantify over @@ -2235,7 +2267,7 @@ a \/\a in the final result but all the occurrences of a will be zonked to () * * ********************************************************************* -} -promoteMetaTyVarTo :: TcLevel -> TcTyVar -> TcM Bool +promoteMetaTyVarTo :: HasDebugCallStack => TcLevel -> TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore -- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion @@ -2253,7 +2285,7 @@ promoteMetaTyVarTo tclvl tv = return False -- Returns whether or not *any* tyvar is defaulted -promoteTyVarSet :: TcTyVarSet -> TcM Bool +promoteTyVarSet :: HasDebugCallStack => TcTyVarSet -> TcM Bool promoteTyVarSet tvs = do { tclvl <- getTcLevel ; bools <- mapM (promoteMetaTyVarTo tclvl) $ ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2072,10 +2072,10 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles , cterHasNoProblem (checkTyVarEq tv1 ty2) -- See Note [Prevent unification with type families] - = do { can_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2 - ; if not can_continue_solving - then not_ok_so_defer - else + = do { mb_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2 + ; case mb_continue_solving of + { Nothing -> not_ok_so_defer + ; Just ty2 -> do { co_k <- uType KindLevel kind_origin (typeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) @@ -2089,9 +2089,9 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 then do { writeMetaTyVar tv1 ty2 ; return (mkNomReflCo ty2) } - else defer }} -- This cannot be solved now. See GHC.Tc.Solver.Canonical - -- Note [Equalities with incompatible kinds] for how - -- this will be dealt with in the solver + else defer }}} -- This cannot be solved now. See GHC.Tc.Solver.Canonical + -- Note [Equalities with incompatible kinds] for how + -- this will be dealt with in the solver | otherwise = not_ok_so_defer @@ -2111,39 +2111,38 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- | Checks (TYVAR-TV), (COERCION-HOLE) and (CONCRETE) of -- Note [Unification preconditions]; returns True if these conditions -- are satisfied. But see the Note for other preconditions, too. -startSolvingByUnification :: MetaInfo -> TcType -- zonked - -> TcM Bool +startSolvingByUnification :: MetaInfo -> TcType -- zonked + -> TcM (Maybe TcType) startSolvingByUnification _ xi | hasCoercionHoleTy xi -- (COERCION-HOLE) check - = return False + = return Nothing startSolvingByUnification info xi = case info of - CycleBreakerTv -> return False + CycleBreakerTv -> return Nothing ConcreteTv conc_orig -> - do { (_, not_conc_reasons) <- makeTypeConcrete conc_orig xi + do { (xi, not_conc_reasons) <- makeTypeConcrete conc_orig xi -- NB: makeTypeConcrete has the side-effect of turning -- some TauTvs into ConcreteTvs, e.g. -- alpha[conc] ~# TYPE (TupleRep '[ beta[tau], IntRep ]) -- will write `beta[tau] := beta[conc]`. -- - -- We don't need to track these unifications for the purposes - -- of constraint solving (e.g. updating tcs_unified or tcs_unif_lvl), - -- as they don't unlock any further progress. + -- We return the new type, so that callers of this function + -- aren't required to zonk. ; case not_conc_reasons of - [] -> return True - _ -> return False } + [] -> return $ Just xi + _ -> return Nothing } TyVarTv -> case getTyVar_maybe xi of - Nothing -> return False + Nothing -> return Nothing Just tv -> case tcTyVarDetails tv of -- (TYVAR-TV) wrinkle - SkolemTv {} -> return True - RuntimeUnk -> return True + SkolemTv {} -> return $ Just xi + RuntimeUnk -> return $ Just xi MetaTv { mtv_info = info } -> case info of - TyVarTv -> return True - _ -> return False - _ -> return True + TyVarTv -> return $ Just xi + _ -> return Nothing + _ -> return $ Just xi swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool swapOverTyVars is_given tv1 tv2 ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -1738,7 +1738,7 @@ change. But in some cases it makes a HUGE difference: see test T9198 and #19668. So yes, it seems worth it. -} -zonkTyVarOcc :: ZonkEnv -> TcTyVar -> TcM Type +zonkTyVarOcc :: HasDebugCallStack => ZonkEnv -> TcTyVar -> TcM Type zonkTyVarOcc env@(ZonkEnv { ze_flexi = flexi , ze_tv_env = tv_env , ze_meta_tv_env = mtv_env_ref }) tv ===================================== testsuite/tests/rep-poly/RepPolyPatBind.stderr ===================================== @@ -17,3 +17,36 @@ RepPolyPatBind.hs:18:5: error: [GHC-55287] x, y :: a (# x, y #) = undefined in x + +RepPolyPatBind.hs:18:8: error: [GHC-55287] + • The pattern binding does not have a fixed runtime representation. + Its type is: + (# a0, b0 #) :: TYPE (TupleRep [k00, k10]) + Cannot unify ‘rep’ with the type variable ‘k00’ + because it is not a concrete ‘RuntimeRep’. + • In the pattern: (# x, y #) + In a pattern binding: (# x, y #) = undefined + In the expression: + let + x, y :: a + (# x, y #) = undefined + in x + • Relevant bindings include + foo :: () -> a (bound at RepPolyPatBind.hs:15:1) + +RepPolyPatBind.hs:18:11: error: [GHC-55287] + • The pattern binding does not have a fixed runtime representation. + Its type is: + (# a0, b0 #) :: TYPE (TupleRep [k00, k10]) + Cannot unify ‘rep’ with the type variable ‘k10’ + because it is not a concrete ‘RuntimeRep’. + • In the pattern: (# x, y #) + In a pattern binding: (# x, y #) = undefined + In the expression: + let + x, y :: a + (# x, y #) = undefined + in x + • Relevant bindings include + x :: a (bound at RepPolyPatBind.hs:18:8) + foo :: () -> a (bound at RepPolyPatBind.hs:15:1) ===================================== testsuite/tests/rep-poly/T23154.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PartialTypeSignatures #-} + +module T23154 where + +import GHC.Exts + +f x = x :: (_ :: (TYPE (_ _))) ===================================== testsuite/tests/rep-poly/T23154.stderr ===================================== @@ -0,0 +1,15 @@ + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -117,3 +117,4 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T23051', normal, compile_fail, ['']) test('T23153', normal, compile_fail, ['']) +test('T23154', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/VtaFail.stderr ===================================== @@ -7,7 +7,7 @@ VtaFail.hs:7:16: error: [GHC-95781] answer_nosig = pairup_nosig @Int @Bool 5 True VtaFail.hs:14:17: error: [GHC-95781] - • Cannot apply expression of type ‘p1 -> p1’ + • Cannot apply expression of type ‘p0 -> p0’ to a visible type argument ‘Int’ • In the expression: (\ x -> x) @Int 12 In an equation for ‘answer_lambda’: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/307ca52badaa72fba06a3f4db006c5204f5b3035 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/307ca52badaa72fba06a3f4db006c5204f5b3035 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 13:19:54 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 23 Mar 2023 09:19:54 -0400 Subject: [Git][ghc/ghc][master] 4 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <641c51faf2b8f_90da4c13e290902688@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - 2 changed files: - libraries/base/Data/Functor/Compose.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/Data/Functor/Compose.hs ===================================== @@ -31,6 +31,8 @@ import Data.Functor.Classes import Control.Applicative import Data.Coerce (coerce) import Data.Data (Data) +import Data.Foldable (Foldable(..)) +import Data.Monoid (Sum(..), All(..), Any(..), Product(..)) import Data.Type.Equality (TestEquality(..), (:~:)(..)) import GHC.Generics (Generic, Generic1) import Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault) @@ -111,7 +113,23 @@ instance (Functor f, Functor g) => Functor (Compose f g) where -- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Compose f g) where + fold (Compose t) = foldMap fold t foldMap f (Compose t) = foldMap (foldMap f) t + foldMap' f (Compose t) = foldMap' (foldMap' f) t + foldr f b (Compose fga) = foldr (\ga acc -> foldr f acc ga) b fga + foldr' f b (Compose fga) = foldr' (\ga acc -> foldr' f acc ga) b fga + foldl f b (Compose fga) = foldl (\acc ga -> foldl f acc ga) b fga + foldl' f b (Compose fga) = foldl' (\acc ga -> foldl' f acc ga) b fga + + null (Compose t) = null t || getAll (foldMap (All . null) t) + length (Compose t) = getSum (foldMap' (Sum . length) t) + elem x (Compose t) = getAny (foldMap (Any . elem x) t) + + minimum (Compose fga) = minimum $ map minimum $ filter (not . null) $ toList fga + maximum (Compose fga) = maximum $ map maximum $ filter (not . null) $ toList fga + + sum (Compose t) = getSum (foldMap' (Sum . sum) t) + product (Compose t) = getProduct (foldMap' (Product . product) t) -- | @since 4.9.0.0 instance (Traversable f, Traversable g) => Traversable (Compose f g) where ===================================== libraries/base/changelog.md ===================================== @@ -12,6 +12,8 @@ * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) + * Implement more members of `instance Foldable (Compose f g)` explicitly. + ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) ## 4.18.0.0 *TBA* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30d45e971d94b3c28296a3f20f94275f38bc89d1...8cb88a5ade9427ca2f26e7f2dbf9defb8fb0ed22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30d45e971d94b3c28296a3f20f94275f38bc89d1...8cb88a5ade9427ca2f26e7f2dbf9defb8fb0ed22 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 13:20:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 23 Mar 2023 09:20:37 -0400 Subject: [Git][ghc/ghc][master] Add structured error messages for GHC.Tc.TyCl.PatSyn Message-ID: <641c5225d546b_90da4c109edc9062e8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 14 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/patsyn/should_fail/T14112.stderr - testsuite/tests/patsyn/should_fail/T14507.stderr - testsuite/tests/patsyn/should_fail/unidir.stderr - + testsuite/tests/typecheck/should_fail/PatSynArity.hs - + testsuite/tests/typecheck/should_fail/PatSynArity.stderr - + testsuite/tests/typecheck/should_fail/PatSynExistential.hs - + testsuite/tests/typecheck/should_fail/PatSynExistential.stderr - + testsuite/tests/typecheck/should_fail/PatSynUnboundVar.hs - + testsuite/tests/typecheck/should_fail/PatSynUnboundVar.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1481,6 +1481,32 @@ instance Diagnostic TcRnMessage where , text "(Indeed, I sometimes struggle even printing this correctly," , text " due to its ill-scoped nature.)" ] + TcRnPatSynEscapedCoercion arg bad_co_ne -> mkSimpleDecorated $ + vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" + , hang (text "Pattern-bound variable") + 2 (ppr arg <+> dcolon <+> ppr (idType arg)) + , nest 2 $ + hang (text "has a type that mentions pattern-bound coercion" + <> plural bad_co_list <> colon) + 2 (pprWithCommas ppr bad_co_list) + , text "Hint: use -fprint-explicit-coercions to see the coercions" + , text "Probable fix: add a pattern signature" ] + where + bad_co_list = NE.toList bad_co_ne + TcRnPatSynExistentialInResult name pat_ty bad_tvs -> mkSimpleDecorated $ + hang (sep [ text "The result type of the signature for" <+> quotes (ppr name) <> comma + , text "namely" <+> quotes (ppr pat_ty) ]) + 2 (text "mentions existential type variable" <> plural bad_tvs + <+> pprQuotedList bad_tvs) + TcRnPatSynArityMismatch name decl_arity missing -> mkSimpleDecorated $ + hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" + <+> speakNOf decl_arity (text "argument")) + 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows") + TcRnPatSynInvalidRhs ps_name lpat args reason -> mkSimpleDecorated $ + vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" + <+> quotes (ppr ps_name) <> colon) + 2 (pprPatSynInvalidRhsReason ps_name lpat args reason) + , text "RHS pattern:" <+> ppr lpat ] diagnosticReason = \case TcRnUnknownMessage m @@ -1965,6 +1991,14 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnSkolemEscape{} -> ErrorWithoutFlag + TcRnPatSynEscapedCoercion{} + -> ErrorWithoutFlag + TcRnPatSynExistentialInResult{} + -> ErrorWithoutFlag + TcRnPatSynArityMismatch{} + -> ErrorWithoutFlag + TcRnPatSynInvalidRhs{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2467,6 +2501,14 @@ instance Diagnostic TcRnMessage where -> noHints TcRnSkolemEscape{} -> noHints + TcRnPatSynEscapedCoercion{} + -> noHints + TcRnPatSynExistentialInResult{} + -> noHints + TcRnPatSynArityMismatch{} + -> noHints + TcRnPatSynInvalidRhs{} + -> noHints diagnosticCode = constructorCode @@ -4561,3 +4603,18 @@ pprUninferrableTyvarCtx = \case UninfTyCtx_Sig exp_kind full_hs_ty -> hang (text "the kind" <+> ppr exp_kind) 2 (text "of the type signature:" <+> ppr full_hs_ty) + +pprPatSynInvalidRhsReason :: Name -> LPat GhcRn -> [LIdP GhcRn] -> PatSynInvalidRhsReason -> SDoc +pprPatSynInvalidRhsReason name pat args = \case + PatSynNotInvertible p -> + text "Pattern" <+> quotes (ppr p) <+> text "is not invertible" + $+$ hang (text "Suggestion: instead use an explicitly bidirectional" + <+> text "pattern synonym, e.g.") + 2 (hang (text "pattern" <+> pp_name <+> pp_args <+> larrow + <+> ppr pat <+> text "where") + 2 (pp_name <+> pp_args <+> equals <+> text "...")) + where + pp_name = ppr name + pp_args = hsep (map ppr args) + PatSynUnboundVar var -> + quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym" ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -95,6 +95,7 @@ module GHC.Tc.Errors.Types ( , WrongThingSort(..) , StageCheckReason(..) , UninferrableTyvarCtx(..) + , PatSynInvalidRhsReason(..) ) where import GHC.Prelude @@ -108,7 +109,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , UserTypeCtxt (PatSynCtxt), TyVarBndrs, TypedThing , FixedRuntimeRepOrigin(..), InstanceWhat ) import GHC.Tc.Types.Rank (Rank) -import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType) +import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType, TcSigmaType) import GHC.Types.Avail (AvailInfo) import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) @@ -118,7 +119,7 @@ import qualified GHC.Types.Name.Occurrence as OccName import GHC.Types.Name.Reader import GHC.Types.SrcLoc import GHC.Types.TyThing (TyThing) -import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar) +import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar, CoVar) import GHC.Types.Var.Env (TidyEnv) import GHC.Types.Var.Set (TyVarSet, VarSet) import GHC.Unit.Types (Module) @@ -3293,6 +3294,52 @@ data TcRnMessage where -> !Type -- ^ The type in which they occur. -> TcRnMessage + {-| TcRnPatSynEscapedCoercion is an error indicating that a coercion escaped from + a pattern synonym into a type. + See Note [Coercions that escape] in GHC.Tc.TyCl.PatSyn + + Test cases: + T14507 + -} + TcRnPatSynEscapedCoercion :: !Id -- ^ The pattern-bound variable + -> !(NE.NonEmpty CoVar) -- ^ The escaped coercions + -> TcRnMessage + + {-| TcRnPatSynExistentialInResult is an error indicating that the result type + of a pattern synonym mentions an existential type variable. + + Test cases: + PatSynExistential + -} + TcRnPatSynExistentialInResult :: !Name -- ^ The name of the pattern synonym + -> !TcSigmaType -- ^ The result type + -> ![TyVar] -- ^ The escaped existential variables + -> TcRnMessage + + {-| TcRnPatSynArityMismatch is an error indicating that the number of arguments in a + pattern synonym's equation differs from the number of parameters in its + signature. + + Test cases: + PatSynArity + -} + TcRnPatSynArityMismatch :: !Name -- ^ The name of the pattern synonym + -> !Arity -- ^ The number of equation arguments + -> !Arity -- ^ The difference + -> TcRnMessage + + {-| TcRnPatSynInvalidRhs is an error group indicating that the pattern on the + right hand side of a pattern synonym is invalid. + + Test cases: + unidir, T14112 + -} + TcRnPatSynInvalidRhs :: !Name -- ^ The name of the pattern synonym + -> !(LPat GhcRn) -- ^ The pattern + -> ![LIdP GhcRn] -- ^ The LHS args + -> !PatSynInvalidRhsReason -- ^ The number of equation arguments + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -4582,3 +4629,8 @@ data UninferrableTyvarCtx | UninfTyCtx_TyfamRhs TcType | UninfTyCtx_TysynRhs TcType | UninfTyCtx_Sig TcType (LHsSigType GhcRn) + +data PatSynInvalidRhsReason + = PatSynNotInvertible !(Pat GhcRn) + | PatSynUnboundVar !Name + deriving (Generic) ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Core.TyCo.Subst( extendTvSubstWithClone ) import GHC.Core.Predicate import GHC.Builtin.Types.Prim -import GHC.Types.Error import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.SrcLoc @@ -68,6 +67,7 @@ import GHC.Driver.Session ( getDynFlags, xopt_FieldSelectors ) import Data.Maybe( mapMaybe ) import Control.Monad ( zipWithM ) import Data.List( partition, mapAccumL ) +import Data.List.NonEmpty (NonEmpty, nonEmpty) {- ************************************************************************ @@ -185,10 +185,11 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details -- Report coercions that escape -- See Note [Coercions that escape] ; args <- mapM zonkId args - ; let bad_args = [ (arg, bad_cos) | arg <- args ++ prov_dicts - , let bad_cos = filterDVarSet isId $ - (tyCoVarsOfTypeDSet (idType arg)) - , not (isEmptyDVarSet bad_cos) ] + ; let bad_arg arg = fmap (\bad_cos -> (arg, bad_cos)) $ + nonEmpty $ + dVarSetElems $ + filterDVarSet isId (tyCoVarsOfTypeDSet (idType arg)) + bad_args = mapMaybe bad_arg (args ++ prov_dicts) ; mapM_ dependentArgErr bad_args -- Report un-quantifiable type variables: @@ -236,22 +237,11 @@ mkProvEvidence ev_id pred = evVarPred ev_id eq_con_args = [evId ev_id] -dependentArgErr :: (Id, DTyCoVarSet) -> TcM () +dependentArgErr :: (Id, NonEmpty CoVar) -> TcM () -- See Note [Coercions that escape] dependentArgErr (arg, bad_cos) = failWithTc $ -- fail here: otherwise we get downstream errors - mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" - , hang (text "Pattern-bound variable") - 2 (ppr arg <+> dcolon <+> ppr (idType arg)) - , nest 2 $ - hang (text "has a type that mentions pattern-bound coercion" - <> plural bad_co_list <> colon) - 2 (pprWithCommas ppr bad_co_list) - , text "Hint: use -fprint-explicit-coercions to see the coercions" - , text "Probable fix: add a pattern signature" ] - where - bad_co_list = dVarSetElems bad_cos + TcRnPatSynEscapedCoercion arg bad_cos {- Note [Type variables whose kind is captured] ~~-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -405,11 +395,7 @@ tcCheckPatSynDecl psb at PSB{ psb_id = lname@(L _ name), psb_args = details -- The existential 'x' should not appear in the result type -- Can't check this until we know P's arity (decl_arity above) ; let bad_tvs = filter (`elemVarSet` tyCoVarsOfType pat_ty) $ binderVars explicit_ex_bndrs - ; checkTc (null bad_tvs) $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (sep [ text "The result type of the signature for" <+> quotes (ppr name) <> comma - , text "namely" <+> quotes (ppr pat_ty) ]) - 2 (text "mentions existential type variable" <> plural bad_tvs - <+> pprQuotedList bad_tvs) + ; checkTc (null bad_tvs) $ TcRnPatSynExistentialInResult name pat_ty bad_tvs -- See Note [The pattern-synonym signature splitting rule] in GHC.Tc.Gen.Sig ; let univ_fvs = closeOverKinds $ @@ -679,10 +665,7 @@ collectPatSynArgInfo details = wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a wrongNumberOfParmsErr name decl_arity missing - = failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" - <+> speakNOf decl_arity (text "argument")) - 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows") + = failWithTc $ TcRnPatSynArityMismatch name decl_arity missing ------------------------- -- Shared by both tcInferPatSyn and tcCheckPatSyn @@ -921,11 +904,7 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) = return emptyBag | Left why <- mb_match_group -- Can't invert the pattern - = setSrcSpan (getLocA lpat) $ failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" - <+> quotes (ppr ps_name) <> colon) - 2 why - , text "RHS pattern:" <+> ppr lpat ] + = setSrcSpan (getLocA lpat) $ failWithTc $ TcRnPatSynInvalidRhs ps_name lpat args why | Right match_group <- mb_match_group -- Bidirectional = do { patsyn <- tcLookupPatSyn ps_name @@ -975,7 +954,7 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) mb_match_group = case dir of ExplicitBidirectional explicit_mg -> Right explicit_mg - ImplicitBidirectional -> fmap mk_mg (tcPatToExpr ps_name args lpat) + ImplicitBidirectional -> fmap mk_mg (tcPatToExpr args lpat) Unidirectional -> panic "tcPatSynBuilderBind" mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn) @@ -1019,8 +998,8 @@ add_void need_dummy_arg ty | need_dummy_arg = mkVisFunTyMany unboxedUnitTy ty | otherwise = ty -tcPatToExpr :: Name -> [LocatedN Name] -> LPat GhcRn - -> Either SDoc (LHsExpr GhcRn) +tcPatToExpr :: [LocatedN Name] -> LPat GhcRn + -> Either PatSynInvalidRhsReason (LHsExpr GhcRn) -- Given a /pattern/, return an /expression/ that builds a value -- that matches the pattern. E.g. if the pattern is (Just [x]), -- the expression is (Just [x]). They look the same, but the @@ -1029,13 +1008,13 @@ tcPatToExpr :: Name -> [LocatedN Name] -> LPat GhcRn -- -- Returns (Left r) if the pattern is not invertible, for reason r. -- See Note [Builder for a bidirectional pattern synonym] -tcPatToExpr name args pat = go pat +tcPatToExpr args pat = go pat where lhsVars = mkNameSet (map unLoc args) -- Make a prefix con for prefix and infix patterns for simplicity mkPrefixConExpr :: LocatedN Name -> [LPat GhcRn] - -> Either SDoc (HsExpr GhcRn) + -> Either PatSynInvalidRhsReason (HsExpr GhcRn) mkPrefixConExpr lcon@(L loc _) pats = do { exprs <- mapM go pats ; let con = L (l2l loc) (HsVar noExtField lcon) @@ -1043,18 +1022,18 @@ tcPatToExpr name args pat = go pat } mkRecordConExpr :: LocatedN Name -> HsRecFields GhcRn (LPat GhcRn) - -> Either SDoc (HsExpr GhcRn) + -> Either PatSynInvalidRhsReason (HsExpr GhcRn) mkRecordConExpr con (HsRecFields fields dd) = do { exprFields <- mapM go' fields ; return (RecordCon noExtField con (HsRecFields exprFields dd)) } - go' :: LHsRecField GhcRn (LPat GhcRn) -> Either SDoc (LHsRecField GhcRn (LHsExpr GhcRn)) + go' :: LHsRecField GhcRn (LPat GhcRn) -> Either PatSynInvalidRhsReason (LHsRecField GhcRn (LHsExpr GhcRn)) go' (L l rf) = L l <$> traverse go rf - go :: LPat GhcRn -> Either SDoc (LHsExpr GhcRn) + go :: LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn) go (L loc p) = L loc <$> go1 p - go1 :: Pat GhcRn -> Either SDoc (HsExpr GhcRn) + go1 :: Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn) go1 (ConPat NoExtField con info) = case info of PrefixCon _ ps -> mkPrefixConExpr con ps @@ -1068,7 +1047,7 @@ tcPatToExpr name args pat = go pat | var `elemNameSet` lhsVars = return $ HsVar noExtField (L l var) | otherwise - = Left (quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym") + = Left (PatSynUnboundVar var) go1 (ParPat _ lpar pat rpar) = fmap (\e -> HsPar noAnn lpar e rpar) $ go pat go1 (ListPat _ pats) = do { exprs <- mapM go pats @@ -1105,19 +1084,7 @@ tcPatToExpr name args pat = go pat go1 p@(AsPat {}) = notInvertible p go1 p@(NPlusKPat {}) = notInvertible p - notInvertible p = Left (not_invertible_msg p) - - not_invertible_msg p - = text "Pattern" <+> quotes (ppr p) <+> text "is not invertible" - $+$ hang (text "Suggestion: instead use an explicitly bidirectional" - <+> text "pattern synonym, e.g.") - 2 (hang (text "pattern" <+> pp_name <+> pp_args <+> larrow - <+> ppr pat <+> text "where") - 2 (pp_name <+> pp_args <+> equals <+> text "...")) - where - pp_name = ppr name - pp_args = hsep (map ppr args) - + notInvertible p = Left (PatSynNotInvertible p) {- Note [Builder for a bidirectional pattern synonym] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -542,6 +542,11 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnCannotDefaultKindVar" = 79924 GhcDiagnosticCode "TcRnUninferrableTyvar" = 16220 GhcDiagnosticCode "TcRnSkolemEscape" = 71451 + GhcDiagnosticCode "TcRnPatSynEscapedCoercion" = 88986 + GhcDiagnosticCode "TcRnPatSynExistentialInResult" = 33973 + GhcDiagnosticCode "TcRnPatSynArityMismatch" = 18365 + GhcDiagnosticCode "PatSynNotInvertible" = 69317 + GhcDiagnosticCode "PatSynUnboundVar" = 28572 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 @@ -711,6 +716,7 @@ type family ConRecursInto con where ConRecursInto "TcRnNotInScope" = 'Just NotInScopeError ConRecursInto "TcRnIllegalNewtype" = 'Just IllegalNewtypeReason ConRecursInto "TcRnHsigShapeMismatch" = 'Just HsigShapeMismatchReason + ConRecursInto "TcRnPatSynInvalidRhs" = 'Just PatSynInvalidRhsReason -- -- TH errors ===================================== testsuite/tests/patsyn/should_fail/T14112.stderr ===================================== @@ -1,5 +1,5 @@ -T14112.hs:5:21: error: +T14112.hs:5:21: error: [GHC-69317] Invalid right-hand side of bidirectional pattern synonym ‘MyJust1’: Pattern ‘!a’ is not invertible Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. ===================================== testsuite/tests/patsyn/should_fail/T14507.stderr ===================================== @@ -1,5 +1,5 @@ -T14507.hs:21:1: error: +T14507.hs:21:1: error: [GHC-88986] • Iceland Jack! Iceland Jack! Stop torturing me! Pattern-bound variable x :: TypeRep a has a type that mentions pattern-bound coercion: co ===================================== testsuite/tests/patsyn/should_fail/unidir.stderr ===================================== @@ -1,5 +1,5 @@ -unidir.hs:4:18: error: +unidir.hs:4:18: error: [GHC-69317] Invalid right-hand side of bidirectional pattern synonym ‘Head’: Pattern ‘_’ is not invertible Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. ===================================== testsuite/tests/typecheck/should_fail/PatSynArity.hs ===================================== @@ -0,0 +1,6 @@ +{-# language PatternSynonyms #-} + +module PatSynArity where + +pattern P :: Int -> (Int, Int) +pattern P a b = (a, b) ===================================== testsuite/tests/typecheck/should_fail/PatSynArity.stderr ===================================== @@ -0,0 +1,4 @@ +PatSynArity.hs:6:1: [GHC-18365] + Pattern synonym ‘P’ has two arguments + but its type signature has 1 fewer arrows + In the declaration for pattern synonym ‘P’ ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.hs ===================================== @@ -0,0 +1,6 @@ +{-# language PatternSynonyms #-} + +module PatSynExistential where + +pattern P :: () => forall x. x -> Maybe x +pattern P <- _ ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.stderr ===================================== @@ -0,0 +1,4 @@ +PatSynExistential.hs:6:1: [GHC-33973] + The result type of the signature for ‘P’, namely ‘x -> Maybe x’ + mentions existential type variable ‘x’ + In the declaration for pattern synonym ‘P’ ===================================== testsuite/tests/typecheck/should_fail/PatSynUnboundVar.hs ===================================== @@ -0,0 +1,6 @@ +{-# language PatternSynonyms #-} + +module PatSynUnboundVar where + +pattern P :: Int -> (Int, Int) +pattern P a = (a, b) ===================================== testsuite/tests/typecheck/should_fail/PatSynUnboundVar.stderr ===================================== @@ -0,0 +1,4 @@ +PatSynUnboundVar.hs:6:15: [GHC-28572] + Invalid right-hand side of bidirectional pattern synonym ‘P’: + ‘b’ is not bound by the LHS of the pattern synonym + RHS pattern: (a, b) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -672,3 +672,6 @@ test('T22924a', normal, compile_fail, ['']) test('T22924b', normal, compile_fail, ['']) test('T22940', normal, compile_fail, ['']) test('T19627', normal, compile_fail, ['']) +test('PatSynExistential', normal, compile_fail, ['']) +test('PatSynArity', normal, compile_fail, ['']) +test('PatSynUnboundVar', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1c8c41d62854553d889403d8ee52d120c26bc66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1c8c41d62854553d889403d8ee52d120c26bc66 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 13:27:55 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 23 Mar 2023 09:27:55 -0400 Subject: [Git][ghc/ghc][wip/T23153] 7 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <641c53db6ae08_90da4c4a5f8c90788b@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23153 at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 5dc6a9c1 by Krzysztof Gogolewski at 2023-03-23T14:22:44+01:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - 9ab9b30e by sheaf at 2023-03-23T14:22:45+01:00 Handle ConcreteTvs in inferResultToType This patch fixes two issues. 1. inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. 2. startSolvingByUnification can make some type variables concrete. However, it didn't return an updated type, so callers of this function, if they don't zonk, might miss this and accidentally perform a double update of a metavariable. We now return the updated type from this function, which avoids this issue. Fixes #23154 - - - - - 29 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Utils/Zonk.hs - compiler/GHC/Types/Error/Codes.hs - libraries/base/Data/Functor/Compose.hs - libraries/base/changelog.md - testsuite/tests/patsyn/should_fail/T14112.stderr - testsuite/tests/patsyn/should_fail/T14507.stderr - testsuite/tests/patsyn/should_fail/unidir.stderr - testsuite/tests/rep-poly/RepPolyPatBind.stderr - + testsuite/tests/rep-poly/T23153.hs - + testsuite/tests/rep-poly/T23153.stderr - + testsuite/tests/rep-poly/T23154.hs - + testsuite/tests/rep-poly/T23154.stderr - testsuite/tests/rep-poly/all.T - + testsuite/tests/typecheck/should_fail/PatSynArity.hs - + testsuite/tests/typecheck/should_fail/PatSynArity.stderr - + testsuite/tests/typecheck/should_fail/PatSynExistential.hs - + testsuite/tests/typecheck/should_fail/PatSynExistential.stderr - + testsuite/tests/typecheck/should_fail/PatSynUnboundVar.hs - + testsuite/tests/typecheck/should_fail/PatSynUnboundVar.stderr - testsuite/tests/typecheck/should_fail/VtaFail.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1481,6 +1481,37 @@ instance Diagnostic TcRnMessage where , text "(Indeed, I sometimes struggle even printing this correctly," , text " due to its ill-scoped nature.)" ] + TcRnPatSynEscapedCoercion arg bad_co_ne -> mkSimpleDecorated $ + vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" + , hang (text "Pattern-bound variable") + 2 (ppr arg <+> dcolon <+> ppr (idType arg)) + , nest 2 $ + hang (text "has a type that mentions pattern-bound coercion" + <> plural bad_co_list <> colon) + 2 (pprWithCommas ppr bad_co_list) + , text "Hint: use -fprint-explicit-coercions to see the coercions" + , text "Probable fix: add a pattern signature" ] + where + bad_co_list = NE.toList bad_co_ne + TcRnPatSynExistentialInResult name pat_ty bad_tvs -> mkSimpleDecorated $ + hang (sep [ text "The result type of the signature for" <+> quotes (ppr name) <> comma + , text "namely" <+> quotes (ppr pat_ty) ]) + 2 (text "mentions existential type variable" <> plural bad_tvs + <+> pprQuotedList bad_tvs) + TcRnPatSynArityMismatch name decl_arity missing -> mkSimpleDecorated $ + hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" + <+> speakNOf decl_arity (text "argument")) + 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows") + TcRnPatSynInvalidRhs ps_name lpat args reason -> mkSimpleDecorated $ + vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" + <+> quotes (ppr ps_name) <> colon) + 2 (pprPatSynInvalidRhsReason ps_name lpat args reason) + , text "RHS pattern:" <+> ppr lpat ] + TcRnCannotDefaultConcrete frr + -> mkSimpleDecorated $ + ppr (frr_context frr) $$ + text "cannot be assigned a fixed runtime representation," <+> + text "not even by defaulting." diagnosticReason = \case TcRnUnknownMessage m @@ -1965,6 +1996,16 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnSkolemEscape{} -> ErrorWithoutFlag + TcRnPatSynEscapedCoercion{} + -> ErrorWithoutFlag + TcRnPatSynExistentialInResult{} + -> ErrorWithoutFlag + TcRnPatSynArityMismatch{} + -> ErrorWithoutFlag + TcRnPatSynInvalidRhs{} + -> ErrorWithoutFlag + TcRnCannotDefaultConcrete{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2467,6 +2508,16 @@ instance Diagnostic TcRnMessage where -> noHints TcRnSkolemEscape{} -> noHints + TcRnPatSynEscapedCoercion{} + -> noHints + TcRnPatSynExistentialInResult{} + -> noHints + TcRnPatSynArityMismatch{} + -> noHints + TcRnPatSynInvalidRhs{} + -> noHints + TcRnCannotDefaultConcrete{} + -> [SuggestAddTypeSignatures UnnamedBinding] diagnosticCode = constructorCode @@ -4561,3 +4612,18 @@ pprUninferrableTyvarCtx = \case UninfTyCtx_Sig exp_kind full_hs_ty -> hang (text "the kind" <+> ppr exp_kind) 2 (text "of the type signature:" <+> ppr full_hs_ty) + +pprPatSynInvalidRhsReason :: Name -> LPat GhcRn -> [LIdP GhcRn] -> PatSynInvalidRhsReason -> SDoc +pprPatSynInvalidRhsReason name pat args = \case + PatSynNotInvertible p -> + text "Pattern" <+> quotes (ppr p) <+> text "is not invertible" + $+$ hang (text "Suggestion: instead use an explicitly bidirectional" + <+> text "pattern synonym, e.g.") + 2 (hang (text "pattern" <+> pp_name <+> pp_args <+> larrow + <+> ppr pat <+> text "where") + 2 (pp_name <+> pp_args <+> equals <+> text "...")) + where + pp_name = ppr name + pp_args = hsep (map ppr args) + PatSynUnboundVar var -> + quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym" ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -95,6 +95,7 @@ module GHC.Tc.Errors.Types ( , WrongThingSort(..) , StageCheckReason(..) , UninferrableTyvarCtx(..) + , PatSynInvalidRhsReason(..) ) where import GHC.Prelude @@ -108,7 +109,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , UserTypeCtxt (PatSynCtxt), TyVarBndrs, TypedThing , FixedRuntimeRepOrigin(..), InstanceWhat ) import GHC.Tc.Types.Rank (Rank) -import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType) +import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType, TcSigmaType) import GHC.Types.Avail (AvailInfo) import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) @@ -118,7 +119,7 @@ import qualified GHC.Types.Name.Occurrence as OccName import GHC.Types.Name.Reader import GHC.Types.SrcLoc import GHC.Types.TyThing (TyThing) -import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar) +import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar, CoVar) import GHC.Types.Var.Env (TidyEnv) import GHC.Types.Var.Set (TyVarSet, VarSet) import GHC.Unit.Types (Module) @@ -3293,6 +3294,62 @@ data TcRnMessage where -> !Type -- ^ The type in which they occur. -> TcRnMessage + {-| TcRnPatSynEscapedCoercion is an error indicating that a coercion escaped from + a pattern synonym into a type. + See Note [Coercions that escape] in GHC.Tc.TyCl.PatSyn + + Test cases: + T14507 + -} + TcRnPatSynEscapedCoercion :: !Id -- ^ The pattern-bound variable + -> !(NE.NonEmpty CoVar) -- ^ The escaped coercions + -> TcRnMessage + + {-| TcRnPatSynExistentialInResult is an error indicating that the result type + of a pattern synonym mentions an existential type variable. + + Test cases: + PatSynExistential + -} + TcRnPatSynExistentialInResult :: !Name -- ^ The name of the pattern synonym + -> !TcSigmaType -- ^ The result type + -> ![TyVar] -- ^ The escaped existential variables + -> TcRnMessage + + {-| TcRnPatSynArityMismatch is an error indicating that the number of arguments in a + pattern synonym's equation differs from the number of parameters in its + signature. + + Test cases: + PatSynArity + -} + TcRnPatSynArityMismatch :: !Name -- ^ The name of the pattern synonym + -> !Arity -- ^ The number of equation arguments + -> !Arity -- ^ The difference + -> TcRnMessage + + {-| TcRnPatSynInvalidRhs is an error group indicating that the pattern on the + right hand side of a pattern synonym is invalid. + + Test cases: + unidir, T14112 + -} + TcRnPatSynInvalidRhs :: !Name -- ^ The name of the pattern synonym + -> !(LPat GhcRn) -- ^ The pattern + -> ![LIdP GhcRn] -- ^ The LHS args + -> !PatSynInvalidRhsReason -- ^ The number of equation arguments + -> TcRnMessage + + {- TcRnCannotDefaultConcrete is an error occurring when a concrete + type variable cannot be defaulted. + + Test cases: + T23153 + -} + TcRnCannotDefaultConcrete + :: !FixedRuntimeRepOrigin + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -4582,3 +4639,8 @@ data UninferrableTyvarCtx | UninfTyCtx_TyfamRhs TcType | UninfTyCtx_TysynRhs TcType | UninfTyCtx_Sig TcType (LHsSigType GhcRn) + +data PatSynInvalidRhsReason + = PatSynNotInvertible !(Pat GhcRn) + | PatSynUnboundVar !Name + deriving (Generic) ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -908,7 +908,7 @@ tcExprWithSig expr hs_ty loc = getLocA (dropWildCards hs_ty) ctxt = ExprSigCtxt (lhsSigWcTypeContextSpan hs_ty) -tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType) +tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcSigmaType) tcExprSig ctxt expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc }) = setSrcSpan loc $ -- Sets the location for the implication constraint do { let poly_ty = idType poly_id ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1651,7 +1651,7 @@ canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) -> MCoercion -- :: kind(rhs) ~N kind(lhs) -> TcS (StopOrContinue Ct) canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco - = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv1 rhs + = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv1 rhs ; if | case is_touchable of { Untouchable -> False; _ -> True } , cterHasNoProblem $ checkTyVarEq tv1 rhs `cterRemoveProblem` cteTypeFamily @@ -2440,7 +2440,7 @@ tryToSolveByUnification tv ; dont_unify } | otherwise - = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv rhs + = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv rhs ; traceTcS "tryToSolveByUnification" (vcat [ ppr tv <+> char '~' <+> ppr rhs , ppr is_touchable ]) ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1326,35 +1326,37 @@ instance Outputable TouchabilityTestResult where ppr (TouchableOuterLevel tvs lvl) = text "TouchableOuterLevel" <> parens (ppr lvl <+> ppr tvs) ppr Untouchable = text "Untouchable" -touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS TouchabilityTestResult --- This is the key test for untouchability: +touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS (TouchabilityTestResult, TcType) +-- ^ This is the key test for untouchability: -- See Note [Unification preconditions] in GHC.Tc.Utils.Unify -- and Note [Solve by unification] in GHC.Tc.Solver.Interact +-- +-- Returns a new rhs type, as this function can turn make some metavariables concrete. touchabilityTest flav tv1 rhs | flav /= Given -- See Note [Do not unify Givens] , MetaTv { mtv_tclvl = tv_lvl, mtv_info = info } <- tcTyVarDetails tv1 - = do { can_continue_solving <- wrapTcS $ startSolvingByUnification info rhs - ; if not can_continue_solving - then return Untouchable - else - do { ambient_lvl <- getTcLevel + = do { continue_solving <- wrapTcS $ startSolvingByUnification info rhs + ; case continue_solving of + { Nothing -> return (Untouchable, rhs) + ; Just rhs -> + do { let (free_metas, free_skols) = partition isPromotableMetaTyVar $ + nonDetEltsUniqSet $ + tyCoVarsOfType rhs + ; ambient_lvl <- getTcLevel ; given_eq_lvl <- getInnermostGivenEqLevel ; if | tv_lvl `sameDepthAs` ambient_lvl - -> return TouchableSameLevel + -> return (TouchableSameLevel, rhs) | tv_lvl `deeperThanOrSame` given_eq_lvl -- No intervening given equalities , all (does_not_escape tv_lvl) free_skols -- No skolem escapes - -> return (TouchableOuterLevel free_metas tv_lvl) + -> return (TouchableOuterLevel free_metas tv_lvl, rhs) | otherwise - -> return Untouchable } } + -> return (Untouchable, rhs) } } } | otherwise - = return Untouchable + = return (Untouchable, rhs) where - (free_metas, free_skols) = partition isPromotableMetaTyVar $ - nonDetEltsUniqSet $ - tyCoVarsOfType rhs does_not_escape tv_lvl fv | isTyVar fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv @@ -2165,23 +2167,21 @@ breakTyEqCycle_maybe ev cte_result lhs rhs -- See Detail (8) of the Note. = do { should_break <- final_check - ; if should_break then do { redn <- go rhs - ; return (Just redn) } - else return Nothing } + ; mapM go should_break } where flavour = ctEvFlavour ev eq_rel = ctEvEqRel ev final_check = case flavour of - Given -> return True + Given -> return $ Just rhs Wanted -- Wanteds work only with a touchable tyvar on the left -- See "Wanted" section of the Note. | TyVarLHS lhs_tv <- lhs -> - do { result <- touchabilityTest Wanted lhs_tv rhs + do { (result, rhs) <- touchabilityTest Wanted lhs_tv rhs ; return $ case result of - Untouchable -> False - _ -> True } - | otherwise -> return False + Untouchable -> Nothing + _ -> Just rhs } + | otherwise -> return Nothing -- This could be considerably more efficient. See Detail (5) of Note. go :: TcType -> TcS ReductionN ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Core.TyCo.Subst( extendTvSubstWithClone ) import GHC.Core.Predicate import GHC.Builtin.Types.Prim -import GHC.Types.Error import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.SrcLoc @@ -68,6 +67,7 @@ import GHC.Driver.Session ( getDynFlags, xopt_FieldSelectors ) import Data.Maybe( mapMaybe ) import Control.Monad ( zipWithM ) import Data.List( partition, mapAccumL ) +import Data.List.NonEmpty (NonEmpty, nonEmpty) {- ************************************************************************ @@ -185,10 +185,11 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details -- Report coercions that escape -- See Note [Coercions that escape] ; args <- mapM zonkId args - ; let bad_args = [ (arg, bad_cos) | arg <- args ++ prov_dicts - , let bad_cos = filterDVarSet isId $ - (tyCoVarsOfTypeDSet (idType arg)) - , not (isEmptyDVarSet bad_cos) ] + ; let bad_arg arg = fmap (\bad_cos -> (arg, bad_cos)) $ + nonEmpty $ + dVarSetElems $ + filterDVarSet isId (tyCoVarsOfTypeDSet (idType arg)) + bad_args = mapMaybe bad_arg (args ++ prov_dicts) ; mapM_ dependentArgErr bad_args -- Report un-quantifiable type variables: @@ -236,22 +237,11 @@ mkProvEvidence ev_id pred = evVarPred ev_id eq_con_args = [evId ev_id] -dependentArgErr :: (Id, DTyCoVarSet) -> TcM () +dependentArgErr :: (Id, NonEmpty CoVar) -> TcM () -- See Note [Coercions that escape] dependentArgErr (arg, bad_cos) = failWithTc $ -- fail here: otherwise we get downstream errors - mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" - , hang (text "Pattern-bound variable") - 2 (ppr arg <+> dcolon <+> ppr (idType arg)) - , nest 2 $ - hang (text "has a type that mentions pattern-bound coercion" - <> plural bad_co_list <> colon) - 2 (pprWithCommas ppr bad_co_list) - , text "Hint: use -fprint-explicit-coercions to see the coercions" - , text "Probable fix: add a pattern signature" ] - where - bad_co_list = dVarSetElems bad_cos + TcRnPatSynEscapedCoercion arg bad_cos {- Note [Type variables whose kind is captured] ~~-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -405,11 +395,7 @@ tcCheckPatSynDecl psb at PSB{ psb_id = lname@(L _ name), psb_args = details -- The existential 'x' should not appear in the result type -- Can't check this until we know P's arity (decl_arity above) ; let bad_tvs = filter (`elemVarSet` tyCoVarsOfType pat_ty) $ binderVars explicit_ex_bndrs - ; checkTc (null bad_tvs) $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (sep [ text "The result type of the signature for" <+> quotes (ppr name) <> comma - , text "namely" <+> quotes (ppr pat_ty) ]) - 2 (text "mentions existential type variable" <> plural bad_tvs - <+> pprQuotedList bad_tvs) + ; checkTc (null bad_tvs) $ TcRnPatSynExistentialInResult name pat_ty bad_tvs -- See Note [The pattern-synonym signature splitting rule] in GHC.Tc.Gen.Sig ; let univ_fvs = closeOverKinds $ @@ -679,10 +665,7 @@ collectPatSynArgInfo details = wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a wrongNumberOfParmsErr name decl_arity missing - = failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" - <+> speakNOf decl_arity (text "argument")) - 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows") + = failWithTc $ TcRnPatSynArityMismatch name decl_arity missing ------------------------- -- Shared by both tcInferPatSyn and tcCheckPatSyn @@ -921,11 +904,7 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) = return emptyBag | Left why <- mb_match_group -- Can't invert the pattern - = setSrcSpan (getLocA lpat) $ failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" - <+> quotes (ppr ps_name) <> colon) - 2 why - , text "RHS pattern:" <+> ppr lpat ] + = setSrcSpan (getLocA lpat) $ failWithTc $ TcRnPatSynInvalidRhs ps_name lpat args why | Right match_group <- mb_match_group -- Bidirectional = do { patsyn <- tcLookupPatSyn ps_name @@ -975,7 +954,7 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) mb_match_group = case dir of ExplicitBidirectional explicit_mg -> Right explicit_mg - ImplicitBidirectional -> fmap mk_mg (tcPatToExpr ps_name args lpat) + ImplicitBidirectional -> fmap mk_mg (tcPatToExpr args lpat) Unidirectional -> panic "tcPatSynBuilderBind" mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn) @@ -1019,8 +998,8 @@ add_void need_dummy_arg ty | need_dummy_arg = mkVisFunTyMany unboxedUnitTy ty | otherwise = ty -tcPatToExpr :: Name -> [LocatedN Name] -> LPat GhcRn - -> Either SDoc (LHsExpr GhcRn) +tcPatToExpr :: [LocatedN Name] -> LPat GhcRn + -> Either PatSynInvalidRhsReason (LHsExpr GhcRn) -- Given a /pattern/, return an /expression/ that builds a value -- that matches the pattern. E.g. if the pattern is (Just [x]), -- the expression is (Just [x]). They look the same, but the @@ -1029,13 +1008,13 @@ tcPatToExpr :: Name -> [LocatedN Name] -> LPat GhcRn -- -- Returns (Left r) if the pattern is not invertible, for reason r. -- See Note [Builder for a bidirectional pattern synonym] -tcPatToExpr name args pat = go pat +tcPatToExpr args pat = go pat where lhsVars = mkNameSet (map unLoc args) -- Make a prefix con for prefix and infix patterns for simplicity mkPrefixConExpr :: LocatedN Name -> [LPat GhcRn] - -> Either SDoc (HsExpr GhcRn) + -> Either PatSynInvalidRhsReason (HsExpr GhcRn) mkPrefixConExpr lcon@(L loc _) pats = do { exprs <- mapM go pats ; let con = L (l2l loc) (HsVar noExtField lcon) @@ -1043,18 +1022,18 @@ tcPatToExpr name args pat = go pat } mkRecordConExpr :: LocatedN Name -> HsRecFields GhcRn (LPat GhcRn) - -> Either SDoc (HsExpr GhcRn) + -> Either PatSynInvalidRhsReason (HsExpr GhcRn) mkRecordConExpr con (HsRecFields fields dd) = do { exprFields <- mapM go' fields ; return (RecordCon noExtField con (HsRecFields exprFields dd)) } - go' :: LHsRecField GhcRn (LPat GhcRn) -> Either SDoc (LHsRecField GhcRn (LHsExpr GhcRn)) + go' :: LHsRecField GhcRn (LPat GhcRn) -> Either PatSynInvalidRhsReason (LHsRecField GhcRn (LHsExpr GhcRn)) go' (L l rf) = L l <$> traverse go rf - go :: LPat GhcRn -> Either SDoc (LHsExpr GhcRn) + go :: LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn) go (L loc p) = L loc <$> go1 p - go1 :: Pat GhcRn -> Either SDoc (HsExpr GhcRn) + go1 :: Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn) go1 (ConPat NoExtField con info) = case info of PrefixCon _ ps -> mkPrefixConExpr con ps @@ -1068,7 +1047,7 @@ tcPatToExpr name args pat = go pat | var `elemNameSet` lhsVars = return $ HsVar noExtField (L l var) | otherwise - = Left (quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym") + = Left (PatSynUnboundVar var) go1 (ParPat _ lpar pat rpar) = fmap (\e -> HsPar noAnn lpar e rpar) $ go pat go1 (ListPat _ pats) = do { exprs <- mapM go pats @@ -1105,19 +1084,7 @@ tcPatToExpr name args pat = go pat go1 p@(AsPat {}) = notInvertible p go1 p@(NPlusKPat {}) = notInvertible p - notInvertible p = Left (not_invertible_msg p) - - not_invertible_msg p - = text "Pattern" <+> quotes (ppr p) <+> text "is not invertible" - $+$ hang (text "Suggestion: instead use an explicitly bidirectional" - <+> text "pattern synonym, e.g.") - 2 (hang (text "pattern" <+> pp_name <+> pp_args <+> larrow - <+> ppr pat <+> text "where") - 2 (pp_name <+> pp_args <+> equals <+> text "...")) - where - pp_name = ppr name - pp_args = hsep (map ppr args) - + notInvertible p = Left (PatSynNotInvertible p) {- Note [Builder for a bidirectional pattern synonym] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecursiveDo #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -480,7 +481,16 @@ newInferExpType :: TcM ExpType newInferExpType = new_inferExpType Nothing newInferExpTypeFRR :: FixedRuntimeRepContext -> TcM ExpTypeFRR -newInferExpTypeFRR frr_orig = new_inferExpType (Just frr_orig) +newInferExpTypeFRR frr_orig + = do { th_stage <- getStage + ; if + -- See [Wrinkle: Typed Template Haskell] + -- in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. + | Brack _ (TcPending {}) <- th_stage + -> new_inferExpType Nothing + + | otherwise + -> new_inferExpType (Just frr_orig) } new_inferExpType :: Maybe FixedRuntimeRepContext -> TcM ExpType new_inferExpType mb_frr_orig @@ -536,20 +546,28 @@ expTypeToType (Infer inf_res) = inferResultToType inf_res inferResultToType :: InferResult -> TcM Type inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl - , ir_ref = ref }) + , ir_ref = ref + , ir_frr = mb_frr }) = do { mb_inferred_ty <- readTcRef ref ; tau <- case mb_inferred_ty of Just ty -> do { ensureMonoType ty -- See Note [inferResultToType] ; return ty } - Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy - ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) - -- See Note [TcLevel of ExpType] + Nothing -> do { tau <- new_meta ; writeMutVar ref (Just tau) ; return tau } ; traceTc "Forcing ExpType to be monomorphic:" (ppr u <+> text ":=" <+> ppr tau) ; return tau } + where + -- See Note [TcLevel of ExpType] + new_meta = case mb_frr of + Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy + ; newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) } + Just frr -> mdo { rr <- newConcreteTyVarAtLevel conc_orig tc_lvl runtimeRepTy + ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) + ; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr + ; return tau } {- Note [inferResultToType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -872,6 +890,13 @@ newTauTvDetailsAtLevel tclvl , mtv_ref = ref , mtv_tclvl = tclvl }) } +newConcreteTvDetailsAtLevel :: ConcreteTvOrigin -> TcLevel -> TcM TcTyVarDetails +newConcreteTvDetailsAtLevel conc_orig tclvl + = do { ref <- newMutVar Flexi + ; return (MetaTv { mtv_info = ConcreteTv conc_orig + , mtv_ref = ref + , mtv_tclvl = tclvl }) } + cloneMetaTyVar :: TcTyVar -> TcM TcTyVar cloneMetaTyVar tv = assert (isTcTyVar tv) $ @@ -917,7 +942,7 @@ isUnfilledMetaTyVar tv -------------------- -- Works with both type and kind variables -writeMetaTyVar :: TcTyVar -> TcType -> TcM () +writeMetaTyVar :: HasDebugCallStack => TcTyVar -> TcType -> TcM () -- Write into a currently-empty MetaTyVar writeMetaTyVar tyvar ty @@ -935,7 +960,7 @@ writeMetaTyVar tyvar ty = massertPpr False (text "Writing to non-meta tyvar" <+> ppr tyvar) -------------------- -writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM () +writeMetaTyVarRef :: HasDebugCallStack => TcTyVar -> TcRef MetaDetails -> TcType -> TcM () -- Here the tyvar is for error checking only; -- the ref cell must be for the same tyvar writeMetaTyVarRef tyvar ref ty @@ -1100,6 +1125,13 @@ newMetaTyVarTyAtLevel tc_lvl kind ; name <- newMetaTyVarName (fsLit "p") ; return (mkTyVarTy (mkTcTyVar name kind details)) } +newConcreteTyVarAtLevel :: ConcreteTvOrigin -> TcLevel -> TcKind -> TcM TcType +newConcreteTyVarAtLevel conc_orig tc_lvl kind + = do { details <- newConcreteTvDetailsAtLevel conc_orig tc_lvl + ; name <- newMetaTyVarName (fsLit "c") + ; return (mkTyVarTy (mkTcTyVar name kind details)) } + + {- ********************************************************************* * * Finding variables to quantify over @@ -2235,7 +2267,7 @@ a \/\a in the final result but all the occurrences of a will be zonked to () * * ********************************************************************* -} -promoteMetaTyVarTo :: TcLevel -> TcTyVar -> TcM Bool +promoteMetaTyVarTo :: HasDebugCallStack => TcLevel -> TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore -- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion @@ -2253,7 +2285,7 @@ promoteMetaTyVarTo tclvl tv = return False -- Returns whether or not *any* tyvar is defaulted -promoteTyVarSet :: TcTyVarSet -> TcM Bool +promoteTyVarSet :: HasDebugCallStack => TcTyVarSet -> TcM Bool promoteTyVarSet tvs = do { tclvl <- getTcLevel ; bools <- mapM (promoteMetaTyVarTo tclvl) $ ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2072,10 +2072,10 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles , cterHasNoProblem (checkTyVarEq tv1 ty2) -- See Note [Prevent unification with type families] - = do { can_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2 - ; if not can_continue_solving - then not_ok_so_defer - else + = do { mb_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2 + ; case mb_continue_solving of + { Nothing -> not_ok_so_defer + ; Just ty2 -> do { co_k <- uType KindLevel kind_origin (typeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) @@ -2089,9 +2089,9 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 then do { writeMetaTyVar tv1 ty2 ; return (mkNomReflCo ty2) } - else defer }} -- This cannot be solved now. See GHC.Tc.Solver.Canonical - -- Note [Equalities with incompatible kinds] for how - -- this will be dealt with in the solver + else defer }}} -- This cannot be solved now. See GHC.Tc.Solver.Canonical + -- Note [Equalities with incompatible kinds] for how + -- this will be dealt with in the solver | otherwise = not_ok_so_defer @@ -2111,39 +2111,38 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- | Checks (TYVAR-TV), (COERCION-HOLE) and (CONCRETE) of -- Note [Unification preconditions]; returns True if these conditions -- are satisfied. But see the Note for other preconditions, too. -startSolvingByUnification :: MetaInfo -> TcType -- zonked - -> TcM Bool +startSolvingByUnification :: MetaInfo -> TcType -- zonked + -> TcM (Maybe TcType) startSolvingByUnification _ xi | hasCoercionHoleTy xi -- (COERCION-HOLE) check - = return False + = return Nothing startSolvingByUnification info xi = case info of - CycleBreakerTv -> return False + CycleBreakerTv -> return Nothing ConcreteTv conc_orig -> - do { (_, not_conc_reasons) <- makeTypeConcrete conc_orig xi + do { (xi, not_conc_reasons) <- makeTypeConcrete conc_orig xi -- NB: makeTypeConcrete has the side-effect of turning -- some TauTvs into ConcreteTvs, e.g. -- alpha[conc] ~# TYPE (TupleRep '[ beta[tau], IntRep ]) -- will write `beta[tau] := beta[conc]`. -- - -- We don't need to track these unifications for the purposes - -- of constraint solving (e.g. updating tcs_unified or tcs_unif_lvl), - -- as they don't unlock any further progress. + -- We return the new type, so that callers of this function + -- aren't required to zonk. ; case not_conc_reasons of - [] -> return True - _ -> return False } + [] -> return $ Just xi + _ -> return Nothing } TyVarTv -> case getTyVar_maybe xi of - Nothing -> return False + Nothing -> return Nothing Just tv -> case tcTyVarDetails tv of -- (TYVAR-TV) wrinkle - SkolemTv {} -> return True - RuntimeUnk -> return True + SkolemTv {} -> return $ Just xi + RuntimeUnk -> return $ Just xi MetaTv { mtv_info = info } -> case info of - TyVarTv -> return True - _ -> return False - _ -> return True + TyVarTv -> return $ Just xi + _ -> return Nothing + _ -> return $ Just xi swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool swapOverTyVars is_given tv1 tv2 ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -56,6 +56,7 @@ import GHC.Tc.Utils.TcType import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) import GHC.Tc.Types.Evidence +import GHC.Tc.Errors.Types import GHC.Core.TyCo.Ppr ( pprTyVar ) import GHC.Core.TyCon @@ -1737,7 +1738,7 @@ change. But in some cases it makes a HUGE difference: see test T9198 and #19668. So yes, it seems worth it. -} -zonkTyVarOcc :: ZonkEnv -> TcTyVar -> TcM Type +zonkTyVarOcc :: HasDebugCallStack => ZonkEnv -> TcTyVar -> TcM Type zonkTyVarOcc env@(ZonkEnv { ze_flexi = flexi , ze_tv_env = tv_env , ze_meta_tv_env = mtv_env_ref }) tv @@ -1810,6 +1811,9 @@ commitFlexi flexi tv zonked_kind | isMultiplicityTy zonked_kind -> do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv) ; return manyDataConTy } + | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv + -> do { addErr $ TcRnCannotDefaultConcrete origin + ; return (anyTypeOfKind zonked_kind) } | otherwise -> do { traceTc "Defaulting flexi tyvar to Any:" (pprTyVar tv) ; return (anyTypeOfKind zonked_kind) } ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -542,6 +542,12 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnCannotDefaultKindVar" = 79924 GhcDiagnosticCode "TcRnUninferrableTyvar" = 16220 GhcDiagnosticCode "TcRnSkolemEscape" = 71451 + GhcDiagnosticCode "TcRnPatSynEscapedCoercion" = 88986 + GhcDiagnosticCode "TcRnPatSynExistentialInResult" = 33973 + GhcDiagnosticCode "TcRnPatSynArityMismatch" = 18365 + GhcDiagnosticCode "PatSynNotInvertible" = 69317 + GhcDiagnosticCode "PatSynUnboundVar" = 28572 + GhcDiagnosticCode "TcRnCannotDefaultConcrete" = 52083 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 @@ -711,6 +717,7 @@ type family ConRecursInto con where ConRecursInto "TcRnNotInScope" = 'Just NotInScopeError ConRecursInto "TcRnIllegalNewtype" = 'Just IllegalNewtypeReason ConRecursInto "TcRnHsigShapeMismatch" = 'Just HsigShapeMismatchReason + ConRecursInto "TcRnPatSynInvalidRhs" = 'Just PatSynInvalidRhsReason -- -- TH errors ===================================== libraries/base/Data/Functor/Compose.hs ===================================== @@ -31,6 +31,8 @@ import Data.Functor.Classes import Control.Applicative import Data.Coerce (coerce) import Data.Data (Data) +import Data.Foldable (Foldable(..)) +import Data.Monoid (Sum(..), All(..), Any(..), Product(..)) import Data.Type.Equality (TestEquality(..), (:~:)(..)) import GHC.Generics (Generic, Generic1) import Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault) @@ -111,7 +113,23 @@ instance (Functor f, Functor g) => Functor (Compose f g) where -- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Compose f g) where + fold (Compose t) = foldMap fold t foldMap f (Compose t) = foldMap (foldMap f) t + foldMap' f (Compose t) = foldMap' (foldMap' f) t + foldr f b (Compose fga) = foldr (\ga acc -> foldr f acc ga) b fga + foldr' f b (Compose fga) = foldr' (\ga acc -> foldr' f acc ga) b fga + foldl f b (Compose fga) = foldl (\acc ga -> foldl f acc ga) b fga + foldl' f b (Compose fga) = foldl' (\acc ga -> foldl' f acc ga) b fga + + null (Compose t) = null t || getAll (foldMap (All . null) t) + length (Compose t) = getSum (foldMap' (Sum . length) t) + elem x (Compose t) = getAny (foldMap (Any . elem x) t) + + minimum (Compose fga) = minimum $ map minimum $ filter (not . null) $ toList fga + maximum (Compose fga) = maximum $ map maximum $ filter (not . null) $ toList fga + + sum (Compose t) = getSum (foldMap' (Sum . sum) t) + product (Compose t) = getProduct (foldMap' (Product . product) t) -- | @since 4.9.0.0 instance (Traversable f, Traversable g) => Traversable (Compose f g) where ===================================== libraries/base/changelog.md ===================================== @@ -12,6 +12,8 @@ * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) + * Implement more members of `instance Foldable (Compose f g)` explicitly. + ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) ## 4.18.0.0 *TBA* ===================================== testsuite/tests/patsyn/should_fail/T14112.stderr ===================================== @@ -1,5 +1,5 @@ -T14112.hs:5:21: error: +T14112.hs:5:21: error: [GHC-69317] Invalid right-hand side of bidirectional pattern synonym ‘MyJust1’: Pattern ‘!a’ is not invertible Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. ===================================== testsuite/tests/patsyn/should_fail/T14507.stderr ===================================== @@ -1,5 +1,5 @@ -T14507.hs:21:1: error: +T14507.hs:21:1: error: [GHC-88986] • Iceland Jack! Iceland Jack! Stop torturing me! Pattern-bound variable x :: TypeRep a has a type that mentions pattern-bound coercion: co ===================================== testsuite/tests/patsyn/should_fail/unidir.stderr ===================================== @@ -1,5 +1,5 @@ -unidir.hs:4:18: error: +unidir.hs:4:18: error: [GHC-69317] Invalid right-hand side of bidirectional pattern synonym ‘Head’: Pattern ‘_’ is not invertible Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. ===================================== testsuite/tests/rep-poly/RepPolyPatBind.stderr ===================================== @@ -17,3 +17,36 @@ RepPolyPatBind.hs:18:5: error: [GHC-55287] x, y :: a (# x, y #) = undefined in x + +RepPolyPatBind.hs:18:8: error: [GHC-55287] + • The pattern binding does not have a fixed runtime representation. + Its type is: + (# a0, b0 #) :: TYPE (TupleRep [k00, k10]) + Cannot unify ‘rep’ with the type variable ‘k00’ + because it is not a concrete ‘RuntimeRep’. + • In the pattern: (# x, y #) + In a pattern binding: (# x, y #) = undefined + In the expression: + let + x, y :: a + (# x, y #) = undefined + in x + • Relevant bindings include + foo :: () -> a (bound at RepPolyPatBind.hs:15:1) + +RepPolyPatBind.hs:18:11: error: [GHC-55287] + • The pattern binding does not have a fixed runtime representation. + Its type is: + (# a0, b0 #) :: TYPE (TupleRep [k00, k10]) + Cannot unify ‘rep’ with the type variable ‘k10’ + because it is not a concrete ‘RuntimeRep’. + • In the pattern: (# x, y #) + In a pattern binding: (# x, y #) = undefined + In the expression: + let + x, y :: a + (# x, y #) = undefined + in x + • Relevant bindings include + x :: a (bound at RepPolyPatBind.hs:18:8) + foo :: () -> a (bound at RepPolyPatBind.hs:15:1) ===================================== testsuite/tests/rep-poly/T23153.hs ===================================== @@ -0,0 +1,8 @@ +module T23153 where + +import GHC.Exts + +f :: forall r s (a :: TYPE (r s)). a -> () +f = f + +g h = f (h ()) ===================================== testsuite/tests/rep-poly/T23153.stderr ===================================== @@ -0,0 +1,15 @@ + +T23153.hs:8:1: error: [GHC-52083] + The argument ‘(h ())’ of ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23153.hs:8:1: error: [GHC-52083] + The argument ‘(h ())’ of ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23153.hs:8:1: error: [GHC-52083] + The argument ‘(h ())’ of ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/T23154.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PartialTypeSignatures #-} + +module T23154 where + +import GHC.Exts + +f x = x :: (_ :: (TYPE (_ _))) ===================================== testsuite/tests/rep-poly/T23154.stderr ===================================== @@ -0,0 +1,15 @@ + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -116,3 +116,5 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T23051', normal, compile_fail, ['']) +test('T23153', normal, compile_fail, ['']) +test('T23154', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/PatSynArity.hs ===================================== @@ -0,0 +1,6 @@ +{-# language PatternSynonyms #-} + +module PatSynArity where + +pattern P :: Int -> (Int, Int) +pattern P a b = (a, b) ===================================== testsuite/tests/typecheck/should_fail/PatSynArity.stderr ===================================== @@ -0,0 +1,4 @@ +PatSynArity.hs:6:1: [GHC-18365] + Pattern synonym ‘P’ has two arguments + but its type signature has 1 fewer arrows + In the declaration for pattern synonym ‘P’ ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.hs ===================================== @@ -0,0 +1,6 @@ +{-# language PatternSynonyms #-} + +module PatSynExistential where + +pattern P :: () => forall x. x -> Maybe x +pattern P <- _ ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.stderr ===================================== @@ -0,0 +1,4 @@ +PatSynExistential.hs:6:1: [GHC-33973] + The result type of the signature for ‘P’, namely ‘x -> Maybe x’ + mentions existential type variable ‘x’ + In the declaration for pattern synonym ‘P’ ===================================== testsuite/tests/typecheck/should_fail/PatSynUnboundVar.hs ===================================== @@ -0,0 +1,6 @@ +{-# language PatternSynonyms #-} + +module PatSynUnboundVar where + +pattern P :: Int -> (Int, Int) +pattern P a = (a, b) ===================================== testsuite/tests/typecheck/should_fail/PatSynUnboundVar.stderr ===================================== @@ -0,0 +1,4 @@ +PatSynUnboundVar.hs:6:15: [GHC-28572] + Invalid right-hand side of bidirectional pattern synonym ‘P’: + ‘b’ is not bound by the LHS of the pattern synonym + RHS pattern: (a, b) ===================================== testsuite/tests/typecheck/should_fail/VtaFail.stderr ===================================== @@ -7,7 +7,7 @@ VtaFail.hs:7:16: error: [GHC-95781] answer_nosig = pairup_nosig @Int @Bool 5 True VtaFail.hs:14:17: error: [GHC-95781] - • Cannot apply expression of type ‘p1 -> p1’ + • Cannot apply expression of type ‘p0 -> p0’ to a visible type argument ‘Int’ • In the expression: (\ x -> x) @Int 12 In an equation for ‘answer_lambda’: ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -672,3 +672,6 @@ test('T22924a', normal, compile_fail, ['']) test('T22924b', normal, compile_fail, ['']) test('T22940', normal, compile_fail, ['']) test('T19627', normal, compile_fail, ['']) +test('PatSynExistential', normal, compile_fail, ['']) +test('PatSynArity', normal, compile_fail, ['']) +test('PatSynUnboundVar', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/307ca52badaa72fba06a3f4db006c5204f5b3035...9ab9b30ec1affe22b188f9a6637ac3bdea75bdba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/307ca52badaa72fba06a3f4db006c5204f5b3035...9ab9b30ec1affe22b188f9a6637ac3bdea75bdba You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 15:30:11 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 11:30:11 -0400 Subject: [Git][ghc/ghc][wip/T23146] 2 commits: testsuite: Add tests for #23146 Message-ID: <641c708380881_90da4e8369c49322e9@gitlab.mail> Ben Gamari pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: ccca7176 by Ben Gamari at 2023-03-23T10:51:21-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 3dab1c85 by romes at 2023-03-23T11:30:06-04:00 Account for all VoidRep types on precomputedStaticConInfo Previously, we were considering coercion values whose unlifted type equality had a zerobit runtime representation (VoidRep) to be constructor arguments when determining whether we should pre-compute a staticConInfo for a data constructor. This made it so that GADT constructors with type-equality constraints that should have no runtime representation actually ended up impacting the code generation. Fixes #23158 - - - - - 10 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/DataCon.hs - + testsuite/tests/codeGen/should_run/T23146.hs - + testsuite/tests/codeGen/should_run/T23146.stdout - + testsuite/tests/codeGen/should_run/T23146A.hs - + testsuite/tests/codeGen/should_run/T23146_lifted.hs - + testsuite/tests/codeGen/should_run/T23146_lifted.stdout - + testsuite/tests/codeGen/should_run/T23146_liftedA.hs - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1397,7 +1397,7 @@ dataConSourceArity (MkData { dcSourceArity = arity }) = arity -- | Gives the number of actual fields in the /representation/ of the -- data constructor. This may be more than appear in the source code; --- the extra ones are the existentially quantified dictionaries +-- the extra ones are the existentially quantified dictionaries. ROMES:TODO: dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -24,6 +24,8 @@ module GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, nonVoidIds, nonVoidStgArgs, assertNonVoidIds, assertNonVoidStgArgs, + isStgNullaryDataCon, + -- * LambdaFormInfo LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... @@ -201,6 +203,18 @@ addArgReps = map (\arg -> let arg' = fromNonVoid arg argPrimRep :: StgArg -> PrimRep argPrimRep arg = typePrimRep1 (stgArgType arg) +-- | Morally equivalent to @isNullaryRepDataCon con@ at the Stg level, where +-- we do not consider types with no runtime representation to be constructor +-- arguments. +-- +-- 'isNullaryRepDataCon' is not fit for checking whether the constructor is +-- nullary at the Stg level because the function 'dataConRepArgTys' it +-- depends on includes unlifted type equalities, whose runtime +-- representation is 'VoidRep', in the returned list. +isStgNullaryDataCon :: DataCon -> Bool +isStgNullaryDataCon = + null . filter (not . isZeroBitTy . scaledThing) . dataConRepArgTys + ------------------------------------------------------ -- Building LambdaFormInfo ------------------------------------------------------ @@ -267,7 +281,7 @@ mkLFImported id = -- Interface doesn't have a LambdaFormInfo, make a conservative one from -- the type. | Just con <- isDataConId_maybe id - , isNullaryRepDataCon con + , isStgNullaryDataCon con -- See Note [Imported nullary datacon wrappers must have correct LFInfo] -- in GHC.StgToCmm.Types -> LFCon con -- An imported nullary constructor ===================================== compiler/GHC/StgToCmm/DataCon.hs ===================================== @@ -37,11 +37,12 @@ import GHC.Runtime.Heap.Layout import GHC.Types.CostCentre import GHC.Unit import GHC.Core.DataCon +import GHC.Core.TyCo.Rep (scaledThing) import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Id.Info( CafInfo( NoCafRefs ) ) import GHC.Types.Name (isInternalName) -import GHC.Types.RepType (countConRepArgs) +import GHC.Types.RepType (countConRepArgs, isZeroBitTy) import GHC.Types.Literal import GHC.Builtin.Utils import GHC.Utils.Panic @@ -327,9 +328,10 @@ because they don't support cross package data references well. precomputedStaticConInfo_maybe :: StgToCmmConfig -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo precomputedStaticConInfo_maybe cfg binder con [] -- Nullary constructors - | isNullaryRepDataCon con + | isStgNullaryDataCon con = Just $ litIdInfo (stgToCmmPlatform cfg) binder (mkConLFInfo con) (CmmLabel (mkClosureLabel (dataConName con) NoCafRefs)) + precomputedStaticConInfo_maybe cfg binder con [arg] -- Int/Char values with existing closures in the RTS | intClosure || charClosure ===================================== testsuite/tests/codeGen/should_run/T23146.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs #-} + +import T23146A + +fieldsSam :: NP xs -> NP xs -> Bool +fieldsSam (x' ::* xs) (y' ::* ys) = fieldsSam xs ys +fieldsSam UNil UNil = True + +main :: IO () +main = print (fieldsSam UNil UNil) + ===================================== testsuite/tests/codeGen/should_run/T23146.stdout ===================================== @@ -0,0 +1,2 @@ +True + ===================================== testsuite/tests/codeGen/should_run/T23146A.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE UnliftedDatatypes #-} +module T23146A where + +import GHC.Exts + +type NP :: [UnliftedType] -> UnliftedType +data NP xs where + UNil :: NP '[] + (::*) :: x -> NP xs -> NP (x ': xs) + ===================================== testsuite/tests/codeGen/should_run/T23146_lifted.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs #-} + +import T23146_liftedA + +fieldsSam :: NP xs -> NP xs -> Bool +fieldsSam (x' ::* xs) (y' ::* ys) = fieldsSam xs ys +fieldsSam UNil UNil = True + +main :: IO () +main = print (fieldsSam UNil UNil) + ===================================== testsuite/tests/codeGen/should_run/T23146_lifted.stdout ===================================== @@ -0,0 +1,2 @@ +True + ===================================== testsuite/tests/codeGen/should_run/T23146_liftedA.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds #-} + +module T23146_liftedA where + +data NP xs where + UNil :: NP '[] + (::*) :: x -> NP xs -> NP (x ': xs) + ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,3 +229,5 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) +test('T23146', normal, compile_and_run, ['']) +test('T23146_lifted', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d53be9081b7c5e248c003e0baf5e006ec559165...3dab1c853eb42ad336b852078b123199516da8a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d53be9081b7c5e248c003e0baf5e006ec559165...3dab1c853eb42ad336b852078b123199516da8a2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 16:27:29 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 12:27:29 -0400 Subject: [Git][ghc/ghc][wip/T23146] Account for all VoidRep types on precomputedStaticConInfo Message-ID: <641c7df19ac1_90da4f73d300939243@gitlab.mail> Ben Gamari pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: b8ce1ba6 by romes at 2023-03-23T12:27:23-04:00 Account for all VoidRep types on precomputedStaticConInfo Previously, we were considering coercion values whose unlifted type equality had a zerobit runtime representation (VoidRep) to be constructor arguments when determining whether we should pre-compute a staticConInfo for a data constructor. This made it so that GADT constructors with type-equality constraints that should have no runtime representation actually ended up impacting the code generation. Fixes #23158 - - - - - 3 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/DataCon.hs Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1397,7 +1397,7 @@ dataConSourceArity (MkData { dcSourceArity = arity }) = arity -- | Gives the number of actual fields in the /representation/ of the -- data constructor. This may be more than appear in the source code; --- the extra ones are the existentially quantified dictionaries +-- the extra ones are the existentially quantified dictionaries. ROMES:TODO: dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -24,6 +24,8 @@ module GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, nonVoidIds, nonVoidStgArgs, assertNonVoidIds, assertNonVoidStgArgs, + isStgNullaryDataCon, + -- * LambdaFormInfo LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... @@ -201,6 +203,18 @@ addArgReps = map (\arg -> let arg' = fromNonVoid arg argPrimRep :: StgArg -> PrimRep argPrimRep arg = typePrimRep1 (stgArgType arg) +-- | Morally equivalent to @isNullaryRepDataCon con@ at the Stg level, where +-- we do not consider types with no runtime representation to be constructor +-- arguments. +-- +-- 'isNullaryRepDataCon' is not fit for checking whether the constructor is +-- nullary at the Stg level because the function 'dataConRepArgTys' it +-- depends on includes unlifted type equalities, whose runtime +-- representation is 'VoidRep', in the returned list. +isStgNullaryDataCon :: DataCon -> Bool +isStgNullaryDataCon = + null . filter (not . isZeroBitTy . scaledThing) . dataConRepArgTys + ------------------------------------------------------ -- Building LambdaFormInfo ------------------------------------------------------ @@ -267,7 +281,7 @@ mkLFImported id = -- Interface doesn't have a LambdaFormInfo, make a conservative one from -- the type. | Just con <- isDataConId_maybe id - , isNullaryRepDataCon con + , isStgNullaryDataCon con -- See Note [Imported nullary datacon wrappers must have correct LFInfo] -- in GHC.StgToCmm.Types -> LFCon con -- An imported nullary constructor ===================================== compiler/GHC/StgToCmm/DataCon.hs ===================================== @@ -327,9 +327,10 @@ because they don't support cross package data references well. precomputedStaticConInfo_maybe :: StgToCmmConfig -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo precomputedStaticConInfo_maybe cfg binder con [] -- Nullary constructors - | isNullaryRepDataCon con + | isStgNullaryDataCon con = Just $ litIdInfo (stgToCmmPlatform cfg) binder (mkConLFInfo con) (CmmLabel (mkClosureLabel (dataConName con) NoCafRefs)) + precomputedStaticConInfo_maybe cfg binder con [arg] -- Int/Char values with existing closures in the RTS | intClosure || charClosure View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8ce1ba698b0740cf7027efdc5e25d03a836b9a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8ce1ba698b0740cf7027efdc5e25d03a836b9a9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 16:48:08 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 12:48:08 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23163 Message-ID: <641c82c84ece0_90da4fccc6f49522e5@gitlab.mail> Ben Gamari pushed new branch wip/T23163 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23163 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 16:48:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 12:48:25 -0400 Subject: [Git][ghc/ghc][wip/T23163] ghc-prim: Generalize keepAlive#/touch# in state token type Message-ID: <641c82d9540ab_90da4f93e94c952413@gitlab.mail> Ben Gamari pushed to branch wip/T23163 at Glasgow Haskell Compiler / GHC Commits: 280ac03b by Ben Gamari at 2023-03-23T12:48:16-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 2 changed files: - compiler/GHC/Builtin/primops.txt.pp - libraries/ghc-prim/changelog.md Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3298,7 +3298,7 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp out_of_line = True primop TouchOp "touch#" GenPrimOp - v -> State# RealWorld -> State# RealWorld + v -> State# s -> State# s with code_size = { 0 } has_side_effects = True @@ -3614,7 +3614,7 @@ section "Controlling object lifetime" -- and "p" is the same as "b" except representation-polymorphic. -- See Note [Levity and representation polymorphic primops] primop KeepAliveOp "keepAlive#" GenPrimOp - v -> State# RealWorld -> (State# RealWorld -> p) -> p + v -> State# s -> (State# s -> p) -> p { @'keepAlive#' x s k@ keeps the value @x@ alive during the execution of the computation @k at . ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -14,6 +14,8 @@ - `sameMutVar#`, `sameTVar#`, `sameMVar#` - `sameIOPort#`, `eqStableName#`. +- `keepAlive#` and `touch#` are now polymorphic in its state token (#23163) + ## 0.10.0 - Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/280ac03b3c6e573f98c66c4e4a5255cf34f10c18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/280ac03b3c6e573f98c66c4e4a5255cf34f10c18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 17:51:40 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 13:51:40 -0400 Subject: [Git][ghc/ghc][wip/T23088] 98 commits: Add `Data.Functor.unzip` Message-ID: <641c91ac43372_90da50e81df498112@gitlab.mail> Ben Gamari pushed to branch wip/T23088 at Glasgow Haskell Compiler / GHC Commits: fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6b09593a by Ben Gamari at 2023-03-23T13:51:31-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - 4028e7fa by Ben Gamari at 2023-03-23T13:51:31-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToByteCode.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35f05ef18d38ac9d8baf531245923d389d76f0d6...4028e7fabc2574e96116919d528cbfc77b403053 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35f05ef18d38ac9d8baf531245923d389d76f0d6...4028e7fabc2574e96116919d528cbfc77b403053 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 17:53:04 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 13:53:04 -0400 Subject: [Git][ghc/ghc][wip/T23088] 2 commits: rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Message-ID: <641c92007f80d_90da50a80174981731@gitlab.mail> Ben Gamari pushed to branch wip/T23088 at Glasgow Haskell Compiler / GHC Commits: f21cdda2 by Ben Gamari at 2023-03-23T13:52:58-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - 25422c95 by Ben Gamari at 2023-03-23T13:52:58-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 4 changed files: - + rts/ZeroSlop.c - rts/include/Cmm.h - rts/include/rts/storage/ClosureMacros.h - rts/rts.cabal.in Changes: ===================================== rts/ZeroSlop.c ===================================== @@ -0,0 +1,27 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2012 + * + * Utilities for zeroing slop callable from Cmm + * + * N.B. If you are in C you should rather using the inlineable utilities + * (e.g. overwritingClosure) defined in ClosureMacros.h. + * + * -------------------------------------------------------------------------- */ + +#include "Rts.h" + +void stg_overwritingClosure (StgClosure *p) +{ + overwritingClosure(p); +} + +void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) +{ + overwritingMutableClosureOfs(p, offset); +} + +void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */) +{ + overwritingClosureSize(p, size); +} ===================================== rts/include/Cmm.h ===================================== @@ -647,9 +647,9 @@ #define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n)) #if defined(PROFILING) || defined(DEBUG) -#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" overwritingClosureSize(c "ptr", size) -#define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr") -#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" overwritingMutableClosureOfs(c "ptr", off) +#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" stg_overwritingClosureSize(c "ptr", size) +#define OVERWRITING_CLOSURE(c) foreign "C" stg_overwritingClosure(c "ptr") +#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" stg_overwritingMutableClosureOfs(c "ptr", off) #else #define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */ #define OVERWRITING_CLOSURE(c) /* nothing */ @@ -657,7 +657,7 @@ * this whenever profiling is enabled as described in Note [slop on the heap] * in Storage.c. */ #define OVERWRITING_CLOSURE_MUTABLE(c, off) \ - if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off); } + if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" stg_overwritingMutableClosureOfs(c "ptr", off); } #endif #define IS_STACK_CLEAN(stack) \ ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -517,16 +517,12 @@ void LDV_recordDead (const StgClosure *c, uint32_t size); RTS_PRIVATE bool isInherentlyUsed ( StgHalfWord closure_type ); #endif -EXTERN_INLINE void -zeroSlop ( - StgClosure *p, - uint32_t offset, /*< offset to start zeroing at, in words */ - uint32_t size, /*< total closure size, in words */ - bool known_mutable /*< is this a closure who's slop we can always zero? */ - ); - -EXTERN_INLINE void -zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) +INLINE_HEADER void +zeroSlop (StgClosure *p, + uint32_t offset, /*< offset to start zeroing at, in words */ + uint32_t size, /*< total closure size, in words */ + bool known_mutable /*< is this a closure who's slop we can always zero? */ + ) { // see Note [zeroing slop when overwriting closures], also #8402 @@ -539,9 +535,8 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) #endif ; - const bool can_zero_immutable_slop = - // Only if we're running single threaded. - RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1; + // Only if we're running single threaded. + const bool can_zero_immutable_slop = getNumCapabilities() == 1; const bool zero_slop_immutable = want_to_zero_immutable_slop && can_zero_immutable_slop; @@ -574,8 +569,10 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) } } -EXTERN_INLINE void overwritingClosure (StgClosure *p); -EXTERN_INLINE void overwritingClosure (StgClosure *p) +// N.B. the stg_* variants of the utilities below are only for calling from +// Cmm. The INLINE_HEADER functions should be used when in C. +void stg_overwritingClosure (StgClosure *p); +INLINE_HEADER void overwritingClosure (StgClosure *p) { W_ size = closure_sizeW(p); #if defined(PROFILING) @@ -585,15 +582,13 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p) zeroSlop(p, sizeofW(StgThunkHeader), size, /*known_mutable=*/false); } + // Version of 'overwritingClosure' which overwrites only a suffix of a // closure. The offset is expressed in words relative to 'p' and shall // be less than or equal to closure_sizeW(p), and usually at least as // large as the respective thunk header. -EXTERN_INLINE void -overwritingMutableClosureOfs (StgClosure *p, uint32_t offset); - -EXTERN_INLINE void -overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) +void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset); +INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) { // Since overwritingClosureOfs is only ever called by: // @@ -610,8 +605,8 @@ overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) } // Version of 'overwritingClosure' which takes closure size as argument. -EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size /* in words */); -EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size) +void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */); +INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size) { // This function is only called from stg_AP_STACK so we can assume it's not // inherently used. ===================================== rts/rts.cabal.in ===================================== @@ -603,6 +603,7 @@ library TSANUtils.c WSDeque.c Weak.c + ZeroSlop.c eventlog/EventLog.c eventlog/EventLogWriter.c hooks/FlagDefaults.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4028e7fabc2574e96116919d528cbfc77b403053...25422c95aaed438cfaf0cccf02c634ecdd6e73f1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4028e7fabc2574e96116919d528cbfc77b403053...25422c95aaed438cfaf0cccf02c634ecdd6e73f1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 18:20:54 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 14:20:54 -0400 Subject: [Git][ghc/ghc][wip/T23030] 19 commits: Rename () into Unit, (, , ..., , ) into Tuple (#21294) Message-ID: <641c9886c935e_90da519071209866ed@gitlab.mail> Ben Gamari pushed to branch wip/T23030 at Glasgow Haskell Compiler / GHC Commits: a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 06247019 by Ben Gamari at 2023-03-23T14:20:49-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 24 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51ad1757e55ad8f8ae4f902c1c609357ab16b952...06247019d0b288c56c66ddc9697a46a5845be5d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51ad1757e55ad8f8ae4f902c1c609357ab16b952...06247019d0b288c56c66ddc9697a46a5845be5d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 19:00:09 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 23 Mar 2023 15:00:09 -0400 Subject: [Git][ghc/ghc][wip/expand-do] do stmt expansion for Applicative Do Message-ID: <641ca1b9dfc4e_90da5246ba20999822@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 2e96c807 by Apoorv Ingle at 2023-03-23T13:59:44-05:00 do stmt expansion for Applicative Do - - - - - 3 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1077,7 +1077,7 @@ instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) -- (ppr orig) - = ppr orig <+> braces (text "Expansion:" <+> ppr expanded) + = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -1813,7 +1813,7 @@ independent and do something like this: (y,z) <- (,) <$> B x <*> C return (f x y z) -But this isn't enough! A and C were also independent, and this +But this isn't enough! If A and C were also independent, then this transformation loses the ability to do A and C in parallel. The algorithm works by first splitting the sequence of statements into ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -71,7 +71,8 @@ import GHC.Builtin.Names (bindMName, returnMName) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc -import GHC.Driver.Session ( getDynFlags ) +import GHC.Driver.Session ( getDynFlags, DynFlags ) +import GHC.Driver.Ppr (showPpr) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name @@ -1220,8 +1221,8 @@ expand_do_stmts do_flavour [L _ (LastStmt _ body _ ret_expr)] expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) - | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn - , Just (SyntaxExprRn fail_op) <- xbsrn_failOp xbsrn = + | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn + , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding x can fail -- stmts ~~> stmt' let f pat = stmts'; f _ = fail ".." -- ------------------------------------------------------- @@ -1233,17 +1234,6 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) , expr ]) - | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn - , Nothing <- xbsrn_failOp xbsrn = -- irrefutable pattern so no failure --- stmts ~~> stmt' --- ------------------------------------------------ --- x <- e ; stmts ~~> (Prelude.>>=) e (\ x -> stmts') - do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ noLocA (foldl genHsApp bind_op -- (>>=) - [ e - , mkHsLam [pat] expand_stmts -- (\ x -> stmts') - ]) - | otherwise = -- just use the polymorhpic bindop. TODO: Necessary? do expand_stmts <- expand_do_stmts do_or_lc lstmts return $ noLocA (genHsApps bindMName -- (Prelude.>>=) @@ -1251,33 +1241,6 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) , mkHsLam [pat] expand_stmts -- (\ x -> stmts') ]) - where - mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn -> TcM (LHsExpr GhcRn) - -- checks the pattern pat and decides if we need to plug in the fail block - -- Type checking the pattern is necessary to decide if we need to generate the fail block - -- Renamer cannot always determine if a fail block is necessary, and its conservative behaviour would - -- generate a fail block even if it is not really needed. cf. GHC.Hs.isIrrefutableHsPat - -- Only Tuples are considered irrefutable in the renamer, while newtypes and TyCons with only one datacon - -- is not - mk_failable_lexpr_tcm pat lexpr fail_op = - do { ((tc_pat, _), _) <- tcInferPat (FRRBindStmt DoNotation) - PatBindRhs pat $ return id -- whatever - ; dflags <- getDynFlags - ; if isIrrefutableHsPat dflags tc_pat - then return $ mkHsLam [pat] lexpr - else return $ mk_fail_lexpr pat lexpr fail_op - } - mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn -> LHsExpr GhcRn - -- makes the fail block - -- TODO: check the discussion around MonadFail.fail type signature. - -- Should we really say `mkHsString "fail pattern"`? if yes, maybe a better error message would help - mk_fail_lexpr pat lexpr fail_op = - noLocA (HsLam noExtField $ mkMatchGroup Generated -- let - (noLocA [ mkHsCaseAlt pat lexpr -- f pat = expr - , mkHsCaseAlt nlWildPatName -- f _ = fail "fail pattern" - (noLocA $ genHsApp fail_op - (nlHsLit $ mkHsString "fail pattern")) ])) - expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = -- stmts ~~> stmts' -- ------------------------------------------------ @@ -1296,13 +1259,14 @@ expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = [ e -- e , expand_stmts ] -- stmts' -expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts - , recS_later_ids = later_ids -- forward referenced local ids - , recS_rec_ids = local_ids -- ids referenced outside of the rec block - , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr - , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr - -- use it explicitly - -- at the end of expanded rec block +expand_do_stmts do_or_lc + ((L _ (RecStmt { recS_stmts = rec_stmts + , recS_later_ids = later_ids -- forward referenced local ids + , recS_rec_ids = local_ids -- ids referenced outside of the rec block + , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr + , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr + -- use it explicitly + -- at the end of expanded rec block })) : lstmts) = -- See Note [Typing a RecStmt] @@ -1320,7 +1284,8 @@ expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts expand_stmts -- stmts') ]) where - local_only_ids = local_ids \\ later_ids -- get unique local rec ids; local rec ids and later ids overlap + local_only_ids = local_ids \\ later_ids -- get unique local rec ids; + --local rec ids and later ids can overlap all_ids = local_only_ids ++ later_ids -- put local ids before return ids return_stmt :: ExprLStmt GhcRn @@ -1336,13 +1301,51 @@ expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts mfix_expr :: LHsExpr GhcRn mfix_expr = mkHsLam [ mkBigLHsVarPatTup all_ids ] $ do_block -expand_do_stmts _ (stmt@(L _ (ApplicativeStmt _ appargs (Just join))):_) = --- See Note [Applicative BodyStmt] - pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" $ ppr stmt - -expand_do_stmts _ (stmt@(L _ (ApplicativeStmt _ appargs Nothing)):_) = +expand_do_stmts do_or_lc (stmt@(L _ (ApplicativeStmt _ args mb_join)): lstmts) = -- See Note [Applicative BodyStmt] - pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" $ ppr stmt +-- +-- stmts ~~> stmts' +-- ------------------------------------------------- +-- ; stmts ~~> (\ x -> stmts') <$> e1 <*> e2 ... +-- +-- Very similar to HsToCore.Expr.dsDo + +-- args are [(<$>, e1), (<*>, e2), .., ] +-- mb_join is Maybe (join) + do { expr' <- expand_do_stmts do_or_lc lstmts + ; (pats_can_fail, rhss) <- unzip <$> mapM (do_arg . snd) args + + ; body <- foldrM match_args expr' pats_can_fail -- add blocks for failable patterns + + ; let expand_ado_expr = foldl mk_app_call body (zip (map fst args) rhss) + ; traceTc "expand_do_stmts: debug" $ (vcat [ text "stmt:" <+> ppr stmt + , text "(pats,rhss):" <+> ppr (pats_can_fail, rhss) + , text "expr':" <+> ppr expr' + , text "args" <+> ppr args + , text "final_ado" <+> ppr expand_ado_expr + ]) + + + -- pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" empty + ; case mb_join of + Nothing -> return expand_ado_expr + Just NoSyntaxExprRn -> return expand_ado_expr -- this is stupid + Just (SyntaxExprRn join_op) -> return $ mkHsApp (noLocA join_op) expand_ado_expr + } + where + do_arg :: ApplicativeArg GhcRn -> TcM ((LPat GhcRn, FailOperator GhcRn), LHsExpr GhcRn) + do_arg (ApplicativeArgOne mb_fail_op pat expr _) = + return ((pat, mb_fail_op), expr) + do_arg (ApplicativeArgMany _ stmts ret pat _) = + do { expr <- expand_do_stmts do_or_lc $ stmts ++ [noLocA $ mkLastStmt (noLocA ret)] + ; return ((pat, Nothing), expr) } + + match_args :: (LPat GhcRn, FailOperator GhcRn) -> LHsExpr GhcRn -> TcM (LHsExpr GhcRn) + match_args (pat, fail_op) body = mk_failable_lexpr_tcm pat body fail_op + + mk_app_call l (op, r) = case op of + SyntaxExprRn op -> mkHsApps (noLocA op) [l, r] + NoSyntaxExprRn -> pprPanic "expand_do_stmts: impossible happened first arg" (ppr op) expand_do_stmts _ (stmt@(L _ (TransStmt {})):_) = pprPanic "expand_do_stmts: impossible happened TransStmt" $ ppr stmt @@ -1354,3 +1357,40 @@ expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = expand_do_stmts do_flavor stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr do_flavor $$ ppr stmts) + + + +mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) +-- checks the pattern pat and decides if we need to plug in the fail block +-- Type checking the pattern is necessary to decide if we need to generate the fail block +-- Renamer cannot always determine if a fail block is necessary, and its conservative behaviour would +-- generate a fail block even if it is not really needed. cf. GHC.Hs.isIrrefutableHsPat +-- Only Tuples are considered irrefutable in the renamer, while newtypes and TyCons with only one datacon +-- is not +mk_failable_lexpr_tcm pat lexpr fail_op = + do { ((tc_pat, _), _) <- tcInferPat (FRRBindStmt DoNotation) + PatBindRhs pat $ return id -- whatever + ; dflags <- getDynFlags + ; if isIrrefutableHsPat dflags tc_pat + then return $ mkHsLam [pat] lexpr + else mk_fail_lexpr pat lexpr fail_op + } + +-- makes the fail block +-- TODO: check the discussion around MonadFail.fail type signature. +-- Should we really say `mkHsString "fail pattern"`? if yes, maybe a better error message would help +mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) +mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = + do dflags <- getDynFlags + return $ noLocA (HsLam noExtField $ mkMatchGroup Generated -- let + (noLocA [ mkHsCaseAlt pat lexpr -- f pat = expr + , mkHsCaseAlt nlWildPatName -- f _ = fail "fail pattern" + (noLocA $ genHsApp fail_op + (mk_fail_msg_expr dflags (DoExpr Nothing) pat)) + ])) +mk_fail_lexpr _ _ _ = pprPanic "mk_fail_lexpr: impossible happened" empty + +mk_fail_msg_expr :: DynFlags -> HsDoFlavour -> LPat GhcRn -> LHsExpr GhcRn +mk_fail_msg_expr dflags ctx pat + = nlHsLit $ mkHsString $ showPpr dflags $ text "Pattern match failure in" <+> pprHsDoFlavour ctx + <+> text "at" <+> ppr (getLocA pat) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e96c807f77dd16775f34d18fa7800215504a908 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e96c807f77dd16775f34d18fa7800215504a908 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 19:00:56 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 23 Mar 2023 15:00:56 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 8 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <641ca1e8ff37_90da5254af041000444@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 59be8f3e by Apoorv Ingle at 2023-03-23T14:00:22-05:00 HsExpand for HsDo Fixes for #18324 - fixed rec do blocks to use mfix - make sure fail is used for pattern match failures in bind statments - - - - - ca100ab6 by Apoorv Ingle at 2023-03-23T14:00:22-05:00 move expand_do_stmts GHC.Tc.Match so that we can type check patterns and determine more accurately if we need to generate a fail block - - - - - 849c014b by Apoorv Ingle at 2023-03-23T14:00:22-05:00 do stmt expansion for Applicative Do - - - - - 25 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Error/Codes.hs - libraries/base/Data/Functor/Compose.hs - libraries/base/changelog.md - testsuite/tests/patsyn/should_fail/T14112.stderr - testsuite/tests/patsyn/should_fail/T14507.stderr - testsuite/tests/patsyn/should_fail/unidir.stderr - + testsuite/tests/rebindable/T18324.hs - + testsuite/tests/rebindable/T23147.hs - testsuite/tests/rebindable/all.T - + testsuite/tests/rebindable/pattern-fails.hs - + testsuite/tests/typecheck/should_fail/PatSynArity.hs - + testsuite/tests/typecheck/should_fail/PatSynArity.stderr - + testsuite/tests/typecheck/should_fail/PatSynExistential.hs - + testsuite/tests/typecheck/should_fail/PatSynExistential.stderr - + testsuite/tests/typecheck/should_fail/PatSynUnboundVar.hs - + testsuite/tests/typecheck/should_fail/PatSynUnboundVar.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -418,6 +418,23 @@ type instance XXExpr GhcTc = XXExprGhcTc -- HsExpansion: see Note [Rebindable syntax and HsExpansion] below + +{- ********************************************************************* +* * + Generating code for HsExpanded + See Note [Handling overloaded and rebindable constructs] +* * +********************************************************************* -} + +-- | Build a 'HsExpansion' out of an extension constructor, +-- and the two components of the expansion: original and +-- desugared expressions. +mkExpandedExpr + :: HsExpr GhcRn -- ^ source expression + -> HsExpr GhcRn -- ^ expanded expression + -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' +mkExpandedExpr a b = XExpr (HsExpanded a b) + data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions {-# UNPACK #-} !(HsWrap HsExpr) @@ -1055,11 +1072,12 @@ data HsExpansion orig expanded = HsExpanded orig expanded deriving Data --- | Just print the original expression (the @a@). +-- | Just print the original expression (the @a@) with the expanded version (the @b@) instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) - = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) - (ppr orig) + -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + -- (ppr orig) + = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- @@ -1961,6 +1979,13 @@ matchDoContextErrString (MDoExpr m) = prependQualified m (text "'mdo' block") matchDoContextErrString ListComp = text "list comprehension" matchDoContextErrString MonadComp = text "monad comprehension" +instance Outputable HsDoFlavour where + ppr (DoExpr m) = text "DoExpr" <+> parens (ppr m) + ppr (MDoExpr m) = text "MDoExpr" <+> parens (ppr m) + ppr GhciStmtCtxt = text "GhciStmtCtxt" + ppr ListComp = text "ListComp" + ppr MonadComp = text "MonadComp" + pprMatchInCtxt :: (OutputableBndrId idR, Outputable body) => Match (GhcPass idR) body -> SDoc pprMatchInCtxt match = hang (text "In" <+> pprMatchContext (m_ctxt match) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -24,7 +24,7 @@ free variables. -} module GHC.Rename.Expr ( - rnLExpr, rnExpr, rnStmts, mkExpandedExpr, + rnLExpr, rnExpr, rnStmts, AnnoBody, UnexpectedStatement(..) ) where @@ -433,8 +433,8 @@ rnExpr (HsDo _ do_or_lc (L l stmts)) rnStmtsWithFreeVars (HsDoStmt do_or_lc) rnExpr stmts (\ _ -> return ((), emptyFVs)) ; (pp_stmts, fvs2) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 - ; return ( HsDo noExtField do_or_lc (L l pp_stmts), fvs1 `plusFV` fvs2 ) } - + ; return (HsDo noExtField do_or_lc (L l pp_stmts), fvs1 `plusFV` fvs2) + } -- ExplicitList: see Note [Handling overloaded and rebindable constructs] rnExpr (ExplicitList _ exps) = do { (exps', fvs) <- rnExprs exps @@ -1071,8 +1071,10 @@ postProcessStmtsForApplicativeDo ctxt stmts ; in_th_bracket <- isBrackStage <$> getStage ; if ado_is_on && is_do_expr && not in_th_bracket then do { traceRn "ppsfa" (ppr stmts) - ; rearrangeForApplicativeDo ctxt stmts } - else noPostProcessStmts (HsDoStmt ctxt) stmts } + ; ado_stmts_and_fvs <- rearrangeForApplicativeDo ctxt stmts + ; return ado_stmts_and_fvs } + else do { do_stmts_and_fvs <- noPostProcessStmts (HsDoStmt ctxt) stmts + ; return do_stmts_and_fvs } } -- | strip the FreeVars annotations from statements noPostProcessStmts @@ -1165,7 +1167,7 @@ rnStmt ctxt rnBody (L loc (LastStmt _ (L lb body) noret _)) thing_inside else return (noSyntaxExpr, emptyFVs) -- The 'return' in a LastStmt is used only -- for MonadComp; and we don't want to report - -- "non in scope: return" in other cases + -- "not in scope: return" in other cases -- #15607 ; (thing, fvs3) <- thing_inside [] @@ -1811,7 +1813,7 @@ independent and do something like this: (y,z) <- (,) <$> B x <*> C return (f x y z) -But this isn't enough! A and C were also independent, and this +But this isn't enough! If A and C were also independent, then this transformation loses the ability to do A and C in parallel. The algorithm works by first splitting the sequence of statements into @@ -2694,14 +2696,6 @@ getMonadFailOp ctxt * * ********************************************************************* -} --- | Build a 'HsExpansion' out of an extension constructor, --- and the two components of the expansion: original and --- desugared expressions. -mkExpandedExpr - :: HsExpr GhcRn -- ^ source expression - -> HsExpr GhcRn -- ^ expanded expression - -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' -mkExpandedExpr a b = XExpr (HsExpanded a b) ----------------------------------------- -- Bits and pieces for RecordDotSyntax. ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1481,6 +1481,32 @@ instance Diagnostic TcRnMessage where , text "(Indeed, I sometimes struggle even printing this correctly," , text " due to its ill-scoped nature.)" ] + TcRnPatSynEscapedCoercion arg bad_co_ne -> mkSimpleDecorated $ + vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" + , hang (text "Pattern-bound variable") + 2 (ppr arg <+> dcolon <+> ppr (idType arg)) + , nest 2 $ + hang (text "has a type that mentions pattern-bound coercion" + <> plural bad_co_list <> colon) + 2 (pprWithCommas ppr bad_co_list) + , text "Hint: use -fprint-explicit-coercions to see the coercions" + , text "Probable fix: add a pattern signature" ] + where + bad_co_list = NE.toList bad_co_ne + TcRnPatSynExistentialInResult name pat_ty bad_tvs -> mkSimpleDecorated $ + hang (sep [ text "The result type of the signature for" <+> quotes (ppr name) <> comma + , text "namely" <+> quotes (ppr pat_ty) ]) + 2 (text "mentions existential type variable" <> plural bad_tvs + <+> pprQuotedList bad_tvs) + TcRnPatSynArityMismatch name decl_arity missing -> mkSimpleDecorated $ + hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" + <+> speakNOf decl_arity (text "argument")) + 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows") + TcRnPatSynInvalidRhs ps_name lpat args reason -> mkSimpleDecorated $ + vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" + <+> quotes (ppr ps_name) <> colon) + 2 (pprPatSynInvalidRhsReason ps_name lpat args reason) + , text "RHS pattern:" <+> ppr lpat ] diagnosticReason = \case TcRnUnknownMessage m @@ -1965,6 +1991,14 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnSkolemEscape{} -> ErrorWithoutFlag + TcRnPatSynEscapedCoercion{} + -> ErrorWithoutFlag + TcRnPatSynExistentialInResult{} + -> ErrorWithoutFlag + TcRnPatSynArityMismatch{} + -> ErrorWithoutFlag + TcRnPatSynInvalidRhs{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2467,6 +2501,14 @@ instance Diagnostic TcRnMessage where -> noHints TcRnSkolemEscape{} -> noHints + TcRnPatSynEscapedCoercion{} + -> noHints + TcRnPatSynExistentialInResult{} + -> noHints + TcRnPatSynArityMismatch{} + -> noHints + TcRnPatSynInvalidRhs{} + -> noHints diagnosticCode = constructorCode @@ -4561,3 +4603,18 @@ pprUninferrableTyvarCtx = \case UninfTyCtx_Sig exp_kind full_hs_ty -> hang (text "the kind" <+> ppr exp_kind) 2 (text "of the type signature:" <+> ppr full_hs_ty) + +pprPatSynInvalidRhsReason :: Name -> LPat GhcRn -> [LIdP GhcRn] -> PatSynInvalidRhsReason -> SDoc +pprPatSynInvalidRhsReason name pat args = \case + PatSynNotInvertible p -> + text "Pattern" <+> quotes (ppr p) <+> text "is not invertible" + $+$ hang (text "Suggestion: instead use an explicitly bidirectional" + <+> text "pattern synonym, e.g.") + 2 (hang (text "pattern" <+> pp_name <+> pp_args <+> larrow + <+> ppr pat <+> text "where") + 2 (pp_name <+> pp_args <+> equals <+> text "...")) + where + pp_name = ppr name + pp_args = hsep (map ppr args) + PatSynUnboundVar var -> + quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym" ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -95,6 +95,7 @@ module GHC.Tc.Errors.Types ( , WrongThingSort(..) , StageCheckReason(..) , UninferrableTyvarCtx(..) + , PatSynInvalidRhsReason(..) ) where import GHC.Prelude @@ -108,7 +109,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , UserTypeCtxt (PatSynCtxt), TyVarBndrs, TypedThing , FixedRuntimeRepOrigin(..), InstanceWhat ) import GHC.Tc.Types.Rank (Rank) -import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType) +import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType, TcSigmaType) import GHC.Types.Avail (AvailInfo) import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) @@ -118,7 +119,7 @@ import qualified GHC.Types.Name.Occurrence as OccName import GHC.Types.Name.Reader import GHC.Types.SrcLoc import GHC.Types.TyThing (TyThing) -import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar) +import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar, CoVar) import GHC.Types.Var.Env (TidyEnv) import GHC.Types.Var.Set (TyVarSet, VarSet) import GHC.Unit.Types (Module) @@ -3293,6 +3294,52 @@ data TcRnMessage where -> !Type -- ^ The type in which they occur. -> TcRnMessage + {-| TcRnPatSynEscapedCoercion is an error indicating that a coercion escaped from + a pattern synonym into a type. + See Note [Coercions that escape] in GHC.Tc.TyCl.PatSyn + + Test cases: + T14507 + -} + TcRnPatSynEscapedCoercion :: !Id -- ^ The pattern-bound variable + -> !(NE.NonEmpty CoVar) -- ^ The escaped coercions + -> TcRnMessage + + {-| TcRnPatSynExistentialInResult is an error indicating that the result type + of a pattern synonym mentions an existential type variable. + + Test cases: + PatSynExistential + -} + TcRnPatSynExistentialInResult :: !Name -- ^ The name of the pattern synonym + -> !TcSigmaType -- ^ The result type + -> ![TyVar] -- ^ The escaped existential variables + -> TcRnMessage + + {-| TcRnPatSynArityMismatch is an error indicating that the number of arguments in a + pattern synonym's equation differs from the number of parameters in its + signature. + + Test cases: + PatSynArity + -} + TcRnPatSynArityMismatch :: !Name -- ^ The name of the pattern synonym + -> !Arity -- ^ The number of equation arguments + -> !Arity -- ^ The difference + -> TcRnMessage + + {-| TcRnPatSynInvalidRhs is an error group indicating that the pattern on the + right hand side of a pattern synonym is invalid. + + Test cases: + unidir, T14112 + -} + TcRnPatSynInvalidRhs :: !Name -- ^ The name of the pattern synonym + -> !(LPat GhcRn) -- ^ The pattern + -> ![LIdP GhcRn] -- ^ The LHS args + -> !PatSynInvalidRhsReason -- ^ The number of equation arguments + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -4582,3 +4629,8 @@ data UninferrableTyvarCtx | UninfTyCtx_TyfamRhs TcType | UninfTyCtx_TysynRhs TcType | UninfTyCtx_Sig TcType (LHsSigType GhcRn) + +data PatSynInvalidRhsReason + = PatSynNotInvertible !(Pat GhcRn) + | PatSynUnboundVar !Name + deriving (Generic) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -49,7 +49,6 @@ import GHC.Tc.Gen.Head import GHC.Tc.Gen.Bind ( tcLocalBinds ) import GHC.Tc.Instance.Family ( tcGetFamInstEnvs ) import GHC.Core.FamInstEnv ( FamInstEnvs ) -import GHC.Rename.Expr ( mkExpandedExpr ) import GHC.Rename.Env ( addUsedGRE ) import GHC.Tc.Utils.Env import GHC.Tc.Gen.Arrow ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -42,7 +42,7 @@ import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRho, tcInferRhoNC , tcCheckMonoExpr, tcCheckMonoExprNC , tcCheckPolyExpr ) -import GHC.Rename.Utils ( bindLocalNames ) +import GHC.Rename.Utils ( bindLocalNames, genHsApp, genHsApps, genHsVar ) import GHC.Tc.Errors.Types import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env @@ -66,21 +66,24 @@ import GHC.Hs import GHC.Builtin.Types import GHC.Builtin.Types.Prim +import GHC.Builtin.Names (bindMName, returnMName) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc -import GHC.Driver.Session ( getDynFlags ) +import GHC.Driver.Session ( getDynFlags, DynFlags ) +import GHC.Driver.Ppr (showPpr) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name import GHC.Types.Id import GHC.Types.SrcLoc +import GHC.Types.Basic (Origin (..)) import Control.Monad import Control.Arrow ( second ) import qualified Data.List.NonEmpty as NE - +import Data.List ((\\)) {- ************************************************************************ * * @@ -316,14 +319,29 @@ tcDoStmts ListComp (L l stmts) res_ty ; return $ mkHsWrapCo co (HsDo list_ty ListComp (L l stmts')) } tcDoStmts doExpr@(DoExpr _) (L l stmts) res_ty - = do { stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty - ; res_ty <- readExpType res_ty - ; return (HsDo res_ty doExpr (L l stmts')) } + = do { -- stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty + -- ; res_ty <- readExpType res_ty + -- ; return (HsDo res_ty doExpr (L l stmts')) + expand_expr <- expand_do_stmts doExpr stmts + ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doExpr (L l stmts)) + (unLoc expand_expr) + -- Do expansion on the fly + ; traceTc "tcDoStmts" (text "tcExpr:" <+> ppr expand_do_expr) + ; tcExpr expand_do_expr res_ty + } tcDoStmts mDoExpr@(MDoExpr _) (L l stmts) res_ty - = do { stmts' <- tcStmts (HsDoStmt mDoExpr) tcDoStmt stmts res_ty - ; res_ty <- readExpType res_ty - ; return (HsDo res_ty mDoExpr (L l stmts')) } + = do { -- stmts' <- tcStmts (HsDoStmt mDoExpr) tcDoStmt stmts res_ty + -- ; res_ty <- readExpType res_ty + -- ; return (HsDo res_ty mDoExpr (L l stmts')) + expand_expr <- expand_do_stmts mDoExpr stmts + ; let expand_do_expr = mkExpandedExpr (HsDo noExtField mDoExpr (L l stmts)) + (unLoc expand_expr) + -- Do expansion on the fly + ; traceTc "tcDoStmts" (text "tcExpr:" <+> ppr expand_do_expr) + ; tcExpr expand_do_expr res_ty + + } tcDoStmts MonadComp (L l stmts) res_ty = do { stmts' <- tcStmts (HsDoStmt MonadComp) tcMcStmt stmts res_ty @@ -857,7 +875,7 @@ tcDoStmt _ (LastStmt x body noret _) res_ty thing_inside = do { body' <- tcMonoExprNC body res_ty ; thing <- thing_inside (panic "tcDoStmt: thing_inside") ; return (LastStmt x body' noret noSyntaxExpr, thing) } - +-- ANI TODO: This is really needed? tcDoStmt ctxt (BindStmt xbsrn pat rhs) res_ty thing_inside = do { -- Deal with rebindable syntax: -- (>>=) :: rhs_ty ->_rhs_mult (pat_ty ->_pat_mult new_res_ty) ->_fun_mult res_ty @@ -896,7 +914,7 @@ tcDoStmt ctxt (ApplicativeStmt _ pairs mb_join) res_ty thing_inside \ [rhs_ty] [rhs_mult] -> tcScalingUsage rhs_mult $ tc_app_stmts (mkCheckExpType rhs_ty)) ; return (ApplicativeStmt body_ty pairs' mb_join', thing) } - +-- ANI TODO: can we get rid of this? tcDoStmt _ (BodyStmt _ rhs then_op _) res_ty thing_inside = do { -- Deal with rebindable syntax; -- (>>) :: rhs_ty -> new_res_ty -> res_ty @@ -909,7 +927,7 @@ tcDoStmt _ (BodyStmt _ rhs then_op _) res_ty thing_inside ; hasFixedRuntimeRep_syntactic (FRRBodyStmt DoNotation 1) rhs_ty ; hasFixedRuntimeRep_syntactic (FRRBodyStmt DoNotation 2) new_res_ty ; return (BodyStmt rhs_ty rhs' then_op' noSyntaxExpr, thing) } - +-- ANI TODO: Is this really needed? tcDoStmt ctxt (RecStmt { recS_stmts = L l stmts, recS_later_ids = later_names , recS_rec_ids = rec_names, recS_ret_fn = ret_op , recS_mfix_fn = mfix_op, recS_bind_fn = bind_op }) @@ -1172,3 +1190,207 @@ checkArgCounts matchContext (MG { mg_alts = L _ (match1:matches) }) args_in_match :: (LocatedA (Match GhcRn body1) -> Int) args_in_match (L _ (Match { m_pats = pats })) = length pats + +{- +************************************************************************ +* * +\subsection{HsExpansion for Do Statements} +* * +************************************************************************ +-} +-- | Expand the Do statments so that it works fine with Quicklook +-- See Note[Rebindable Do and Expanding Statements] +-- ANI Questions: 1. What should be the location information in the expanded expression? Currently the error is displayed on the expanded expr and not on the unexpanded expr +expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) + +expand_do_stmts do_flavour [L _ (LastStmt _ body _ ret_expr)] + -- last statement of a list comprehension, needs to explicitly return it + -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` + -- TODO: i don't think we need this if we never call from a ListComp + | ListComp <- do_flavour + = return $ noLocA (genHsApp (genHsVar returnMName) body) + | NoSyntaxExprRn <- ret_expr + -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt + = return body + | SyntaxExprRn ret <- ret_expr + -- + -- ------------------------------------------------ + -- return e ~~> return e + -- to make T18324 work + = return $ mkHsApp (noLocA ret) body + + +expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) + | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn + , fail_op <- xbsrn_failOp xbsrn = +-- the pattern binding x can fail +-- stmts ~~> stmt' let f pat = stmts'; f _ = fail ".." +-- ------------------------------------------------------- +-- pat <- e ; stmts ~~> (Prelude.>>=) e f + do expand_stmts <- expand_do_stmts do_or_lc lstmts + expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op + return $ noLocA (foldl genHsApp bind_op -- (>>=) + [ e + , expr + ]) + + | otherwise = -- just use the polymorhpic bindop. TODO: Necessary? + do expand_stmts <- expand_do_stmts do_or_lc lstmts + return $ noLocA (genHsApps bindMName -- (Prelude.>>=) + [ e + , mkHsLam [pat] expand_stmts -- (\ x -> stmts') + ]) + +expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = +-- stmts ~~> stmts' +-- ------------------------------------------------ +-- let x = e ; stmts ~~> let x = e in stmts' + do expand_stmts <- expand_do_stmts do_or_lc lstmts + return $ noLocA (HsLet noExtField noHsTok bnds noHsTok (expand_stmts)) + + +expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = +-- See Note [BodyStmt] +-- stmts ~~> stmts' +-- ---------------------------------------------- +-- e ; stmts ~~> (>>) e stmts' + do expand_stmts <- expand_do_stmts do_or_lc lstmts + return $ mkHsApps (noLocA f) -- (>>) + [ e -- e + , expand_stmts ] -- stmts' + +expand_do_stmts do_or_lc + ((L _ (RecStmt { recS_stmts = rec_stmts + , recS_later_ids = later_ids -- forward referenced local ids + , recS_rec_ids = local_ids -- ids referenced outside of the rec block + , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr + , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr + -- use it explicitly + -- at the end of expanded rec block + })) + : lstmts) = +-- See Note [Typing a RecStmt] +-- stmts ~~> stmts' +-- ------------------------------------------------------------------------------------------- +-- rec { later_ids, local_ids, rec_block } ; stmts +-- ~~> (>>=) (mfix (\[ local_only_ids ++ later_ids ] +-- -> do { rec_stmts +-- ; return (local_only_ids ++ later_ids) } )) +-- (\ [ local_only_ids ++ later_ids ] -> stmts') + do expand_stmts <- expand_do_stmts do_or_lc lstmts + return $ noLocA (genHsApps bindMName -- (Prelude.>>=) + [ (noLocA mfix_fun) `mkHsApp` mfix_expr -- (mfix (do block)) + , mkHsLam [ mkBigLHsVarPatTup all_ids ] -- (\ x -> + expand_stmts -- stmts') + ]) + where + local_only_ids = local_ids \\ later_ids -- get unique local rec ids; + --local rec ids and later ids can overlap + all_ids = local_only_ids ++ later_ids -- put local ids before return ids + + return_stmt :: ExprLStmt GhcRn + return_stmt = noLocA $ LastStmt noExtField + (mkHsApp (noLocA return_fun) + $ mkBigLHsTup (map nlHsVar all_ids) noExtField) + Nothing + (SyntaxExprRn return_fun) + do_stmts :: XRec GhcRn [ExprLStmt GhcRn] + do_stmts = noLocA $ (unLoc rec_stmts) ++ [return_stmt] + do_block :: LHsExpr GhcRn + do_block = noLocA $ HsDo noExtField (DoExpr Nothing) $ do_stmts + mfix_expr :: LHsExpr GhcRn + mfix_expr = mkHsLam [ mkBigLHsVarPatTup all_ids ] $ do_block + +expand_do_stmts do_or_lc (stmt@(L _ (ApplicativeStmt _ args mb_join)): lstmts) = +-- See Note [Applicative BodyStmt] +-- +-- stmts ~~> stmts' +-- ------------------------------------------------- +-- ; stmts ~~> (\ x -> stmts') <$> e1 <*> e2 ... +-- +-- Very similar to HsToCore.Expr.dsDo + +-- args are [(<$>, e1), (<*>, e2), .., ] +-- mb_join is Maybe (join) + do { expr' <- expand_do_stmts do_or_lc lstmts + ; (pats_can_fail, rhss) <- unzip <$> mapM (do_arg . snd) args + + ; body <- foldrM match_args expr' pats_can_fail -- add blocks for failable patterns + + ; let expand_ado_expr = foldl mk_app_call body (zip (map fst args) rhss) + ; traceTc "expand_do_stmts: debug" $ (vcat [ text "stmt:" <+> ppr stmt + , text "(pats,rhss):" <+> ppr (pats_can_fail, rhss) + , text "expr':" <+> ppr expr' + , text "args" <+> ppr args + , text "final_ado" <+> ppr expand_ado_expr + ]) + + + -- pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" empty + ; case mb_join of + Nothing -> return expand_ado_expr + Just NoSyntaxExprRn -> return expand_ado_expr -- this is stupid + Just (SyntaxExprRn join_op) -> return $ mkHsApp (noLocA join_op) expand_ado_expr + } + where + do_arg :: ApplicativeArg GhcRn -> TcM ((LPat GhcRn, FailOperator GhcRn), LHsExpr GhcRn) + do_arg (ApplicativeArgOne mb_fail_op pat expr _) = + return ((pat, mb_fail_op), expr) + do_arg (ApplicativeArgMany _ stmts ret pat _) = + do { expr <- expand_do_stmts do_or_lc $ stmts ++ [noLocA $ mkLastStmt (noLocA ret)] + ; return ((pat, Nothing), expr) } + + match_args :: (LPat GhcRn, FailOperator GhcRn) -> LHsExpr GhcRn -> TcM (LHsExpr GhcRn) + match_args (pat, fail_op) body = mk_failable_lexpr_tcm pat body fail_op + + mk_app_call l (op, r) = case op of + SyntaxExprRn op -> mkHsApps (noLocA op) [l, r] + NoSyntaxExprRn -> pprPanic "expand_do_stmts: impossible happened first arg" (ppr op) + +expand_do_stmts _ (stmt@(L _ (TransStmt {})):_) = + pprPanic "expand_do_stmts: impossible happened TransStmt" $ ppr stmt + +expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = +-- See See Note [Monad Comprehensions] + + pprPanic "expand_do_stmts: impossible happened ParStmt" $ ppr stmt + + +expand_do_stmts do_flavor stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr do_flavor $$ ppr stmts) + + + +mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) +-- checks the pattern pat and decides if we need to plug in the fail block +-- Type checking the pattern is necessary to decide if we need to generate the fail block +-- Renamer cannot always determine if a fail block is necessary, and its conservative behaviour would +-- generate a fail block even if it is not really needed. cf. GHC.Hs.isIrrefutableHsPat +-- Only Tuples are considered irrefutable in the renamer, while newtypes and TyCons with only one datacon +-- is not +mk_failable_lexpr_tcm pat lexpr fail_op = + do { ((tc_pat, _), _) <- tcInferPat (FRRBindStmt DoNotation) + PatBindRhs pat $ return id -- whatever + ; dflags <- getDynFlags + ; if isIrrefutableHsPat dflags tc_pat + then return $ mkHsLam [pat] lexpr + else mk_fail_lexpr pat lexpr fail_op + } + +-- makes the fail block +-- TODO: check the discussion around MonadFail.fail type signature. +-- Should we really say `mkHsString "fail pattern"`? if yes, maybe a better error message would help +mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) +mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = + do dflags <- getDynFlags + return $ noLocA (HsLam noExtField $ mkMatchGroup Generated -- let + (noLocA [ mkHsCaseAlt pat lexpr -- f pat = expr + , mkHsCaseAlt nlWildPatName -- f _ = fail "fail pattern" + (noLocA $ genHsApp fail_op + (mk_fail_msg_expr dflags (DoExpr Nothing) pat)) + ])) +mk_fail_lexpr _ _ _ = pprPanic "mk_fail_lexpr: impossible happened" empty + +mk_fail_msg_expr :: DynFlags -> HsDoFlavour -> LPat GhcRn -> LHsExpr GhcRn +mk_fail_msg_expr dflags ctx pat + = nlHsLit $ mkHsString $ showPpr dflags $ text "Pattern match failure in" <+> pprHsDoFlavour ctx + <+> text "at" <+> ppr (getLocA pat) ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -104,7 +104,7 @@ tcLetPat sig_fn no_gen pat pat_ty thing_inside ----------------- tcPats :: HsMatchContext GhcTc - -> [LPat GhcRn] -- ^ atterns + -> [LPat GhcRn] -- ^ patterns -> [Scaled ExpSigmaTypeFRR] -- ^ types of the patterns -> TcM a -- ^ checker for the body -> TcM ([LPat GhcTc], a) ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Core.TyCo.Subst( extendTvSubstWithClone ) import GHC.Core.Predicate import GHC.Builtin.Types.Prim -import GHC.Types.Error import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.SrcLoc @@ -68,6 +67,7 @@ import GHC.Driver.Session ( getDynFlags, xopt_FieldSelectors ) import Data.Maybe( mapMaybe ) import Control.Monad ( zipWithM ) import Data.List( partition, mapAccumL ) +import Data.List.NonEmpty (NonEmpty, nonEmpty) {- ************************************************************************ @@ -185,10 +185,11 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details -- Report coercions that escape -- See Note [Coercions that escape] ; args <- mapM zonkId args - ; let bad_args = [ (arg, bad_cos) | arg <- args ++ prov_dicts - , let bad_cos = filterDVarSet isId $ - (tyCoVarsOfTypeDSet (idType arg)) - , not (isEmptyDVarSet bad_cos) ] + ; let bad_arg arg = fmap (\bad_cos -> (arg, bad_cos)) $ + nonEmpty $ + dVarSetElems $ + filterDVarSet isId (tyCoVarsOfTypeDSet (idType arg)) + bad_args = mapMaybe bad_arg (args ++ prov_dicts) ; mapM_ dependentArgErr bad_args -- Report un-quantifiable type variables: @@ -236,22 +237,11 @@ mkProvEvidence ev_id pred = evVarPred ev_id eq_con_args = [evId ev_id] -dependentArgErr :: (Id, DTyCoVarSet) -> TcM () +dependentArgErr :: (Id, NonEmpty CoVar) -> TcM () -- See Note [Coercions that escape] dependentArgErr (arg, bad_cos) = failWithTc $ -- fail here: otherwise we get downstream errors - mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" - , hang (text "Pattern-bound variable") - 2 (ppr arg <+> dcolon <+> ppr (idType arg)) - , nest 2 $ - hang (text "has a type that mentions pattern-bound coercion" - <> plural bad_co_list <> colon) - 2 (pprWithCommas ppr bad_co_list) - , text "Hint: use -fprint-explicit-coercions to see the coercions" - , text "Probable fix: add a pattern signature" ] - where - bad_co_list = dVarSetElems bad_cos + TcRnPatSynEscapedCoercion arg bad_cos {- Note [Type variables whose kind is captured] ~~-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -405,11 +395,7 @@ tcCheckPatSynDecl psb at PSB{ psb_id = lname@(L _ name), psb_args = details -- The existential 'x' should not appear in the result type -- Can't check this until we know P's arity (decl_arity above) ; let bad_tvs = filter (`elemVarSet` tyCoVarsOfType pat_ty) $ binderVars explicit_ex_bndrs - ; checkTc (null bad_tvs) $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (sep [ text "The result type of the signature for" <+> quotes (ppr name) <> comma - , text "namely" <+> quotes (ppr pat_ty) ]) - 2 (text "mentions existential type variable" <> plural bad_tvs - <+> pprQuotedList bad_tvs) + ; checkTc (null bad_tvs) $ TcRnPatSynExistentialInResult name pat_ty bad_tvs -- See Note [The pattern-synonym signature splitting rule] in GHC.Tc.Gen.Sig ; let univ_fvs = closeOverKinds $ @@ -679,10 +665,7 @@ collectPatSynArgInfo details = wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a wrongNumberOfParmsErr name decl_arity missing - = failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" - <+> speakNOf decl_arity (text "argument")) - 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows") + = failWithTc $ TcRnPatSynArityMismatch name decl_arity missing ------------------------- -- Shared by both tcInferPatSyn and tcCheckPatSyn @@ -921,11 +904,7 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) = return emptyBag | Left why <- mb_match_group -- Can't invert the pattern - = setSrcSpan (getLocA lpat) $ failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" - <+> quotes (ppr ps_name) <> colon) - 2 why - , text "RHS pattern:" <+> ppr lpat ] + = setSrcSpan (getLocA lpat) $ failWithTc $ TcRnPatSynInvalidRhs ps_name lpat args why | Right match_group <- mb_match_group -- Bidirectional = do { patsyn <- tcLookupPatSyn ps_name @@ -975,7 +954,7 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) mb_match_group = case dir of ExplicitBidirectional explicit_mg -> Right explicit_mg - ImplicitBidirectional -> fmap mk_mg (tcPatToExpr ps_name args lpat) + ImplicitBidirectional -> fmap mk_mg (tcPatToExpr args lpat) Unidirectional -> panic "tcPatSynBuilderBind" mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn) @@ -1019,8 +998,8 @@ add_void need_dummy_arg ty | need_dummy_arg = mkVisFunTyMany unboxedUnitTy ty | otherwise = ty -tcPatToExpr :: Name -> [LocatedN Name] -> LPat GhcRn - -> Either SDoc (LHsExpr GhcRn) +tcPatToExpr :: [LocatedN Name] -> LPat GhcRn + -> Either PatSynInvalidRhsReason (LHsExpr GhcRn) -- Given a /pattern/, return an /expression/ that builds a value -- that matches the pattern. E.g. if the pattern is (Just [x]), -- the expression is (Just [x]). They look the same, but the @@ -1029,13 +1008,13 @@ tcPatToExpr :: Name -> [LocatedN Name] -> LPat GhcRn -- -- Returns (Left r) if the pattern is not invertible, for reason r. -- See Note [Builder for a bidirectional pattern synonym] -tcPatToExpr name args pat = go pat +tcPatToExpr args pat = go pat where lhsVars = mkNameSet (map unLoc args) -- Make a prefix con for prefix and infix patterns for simplicity mkPrefixConExpr :: LocatedN Name -> [LPat GhcRn] - -> Either SDoc (HsExpr GhcRn) + -> Either PatSynInvalidRhsReason (HsExpr GhcRn) mkPrefixConExpr lcon@(L loc _) pats = do { exprs <- mapM go pats ; let con = L (l2l loc) (HsVar noExtField lcon) @@ -1043,18 +1022,18 @@ tcPatToExpr name args pat = go pat } mkRecordConExpr :: LocatedN Name -> HsRecFields GhcRn (LPat GhcRn) - -> Either SDoc (HsExpr GhcRn) + -> Either PatSynInvalidRhsReason (HsExpr GhcRn) mkRecordConExpr con (HsRecFields fields dd) = do { exprFields <- mapM go' fields ; return (RecordCon noExtField con (HsRecFields exprFields dd)) } - go' :: LHsRecField GhcRn (LPat GhcRn) -> Either SDoc (LHsRecField GhcRn (LHsExpr GhcRn)) + go' :: LHsRecField GhcRn (LPat GhcRn) -> Either PatSynInvalidRhsReason (LHsRecField GhcRn (LHsExpr GhcRn)) go' (L l rf) = L l <$> traverse go rf - go :: LPat GhcRn -> Either SDoc (LHsExpr GhcRn) + go :: LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn) go (L loc p) = L loc <$> go1 p - go1 :: Pat GhcRn -> Either SDoc (HsExpr GhcRn) + go1 :: Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn) go1 (ConPat NoExtField con info) = case info of PrefixCon _ ps -> mkPrefixConExpr con ps @@ -1068,7 +1047,7 @@ tcPatToExpr name args pat = go pat | var `elemNameSet` lhsVars = return $ HsVar noExtField (L l var) | otherwise - = Left (quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym") + = Left (PatSynUnboundVar var) go1 (ParPat _ lpar pat rpar) = fmap (\e -> HsPar noAnn lpar e rpar) $ go pat go1 (ListPat _ pats) = do { exprs <- mapM go pats @@ -1105,19 +1084,7 @@ tcPatToExpr name args pat = go pat go1 p@(AsPat {}) = notInvertible p go1 p@(NPlusKPat {}) = notInvertible p - notInvertible p = Left (not_invertible_msg p) - - not_invertible_msg p - = text "Pattern" <+> quotes (ppr p) <+> text "is not invertible" - $+$ hang (text "Suggestion: instead use an explicitly bidirectional" - <+> text "pattern synonym, e.g.") - 2 (hang (text "pattern" <+> pp_name <+> pp_args <+> larrow - <+> ppr pat <+> text "where") - 2 (pp_name <+> pp_args <+> equals <+> text "...")) - where - pp_name = ppr name - pp_args = hsep (map ppr args) - + notInvertible p = Left (PatSynNotInvertible p) {- Note [Builder for a bidirectional pattern synonym] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -542,6 +542,11 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnCannotDefaultKindVar" = 79924 GhcDiagnosticCode "TcRnUninferrableTyvar" = 16220 GhcDiagnosticCode "TcRnSkolemEscape" = 71451 + GhcDiagnosticCode "TcRnPatSynEscapedCoercion" = 88986 + GhcDiagnosticCode "TcRnPatSynExistentialInResult" = 33973 + GhcDiagnosticCode "TcRnPatSynArityMismatch" = 18365 + GhcDiagnosticCode "PatSynNotInvertible" = 69317 + GhcDiagnosticCode "PatSynUnboundVar" = 28572 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 @@ -711,6 +716,7 @@ type family ConRecursInto con where ConRecursInto "TcRnNotInScope" = 'Just NotInScopeError ConRecursInto "TcRnIllegalNewtype" = 'Just IllegalNewtypeReason ConRecursInto "TcRnHsigShapeMismatch" = 'Just HsigShapeMismatchReason + ConRecursInto "TcRnPatSynInvalidRhs" = 'Just PatSynInvalidRhsReason -- -- TH errors ===================================== libraries/base/Data/Functor/Compose.hs ===================================== @@ -31,6 +31,8 @@ import Data.Functor.Classes import Control.Applicative import Data.Coerce (coerce) import Data.Data (Data) +import Data.Foldable (Foldable(..)) +import Data.Monoid (Sum(..), All(..), Any(..), Product(..)) import Data.Type.Equality (TestEquality(..), (:~:)(..)) import GHC.Generics (Generic, Generic1) import Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault) @@ -111,7 +113,23 @@ instance (Functor f, Functor g) => Functor (Compose f g) where -- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Compose f g) where + fold (Compose t) = foldMap fold t foldMap f (Compose t) = foldMap (foldMap f) t + foldMap' f (Compose t) = foldMap' (foldMap' f) t + foldr f b (Compose fga) = foldr (\ga acc -> foldr f acc ga) b fga + foldr' f b (Compose fga) = foldr' (\ga acc -> foldr' f acc ga) b fga + foldl f b (Compose fga) = foldl (\acc ga -> foldl f acc ga) b fga + foldl' f b (Compose fga) = foldl' (\acc ga -> foldl' f acc ga) b fga + + null (Compose t) = null t || getAll (foldMap (All . null) t) + length (Compose t) = getSum (foldMap' (Sum . length) t) + elem x (Compose t) = getAny (foldMap (Any . elem x) t) + + minimum (Compose fga) = minimum $ map minimum $ filter (not . null) $ toList fga + maximum (Compose fga) = maximum $ map maximum $ filter (not . null) $ toList fga + + sum (Compose t) = getSum (foldMap' (Sum . sum) t) + product (Compose t) = getProduct (foldMap' (Product . product) t) -- | @since 4.9.0.0 instance (Traversable f, Traversable g) => Traversable (Compose f g) where ===================================== libraries/base/changelog.md ===================================== @@ -12,6 +12,8 @@ * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) + * Implement more members of `instance Foldable (Compose f g)` explicitly. + ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) ## 4.18.0.0 *TBA* ===================================== testsuite/tests/patsyn/should_fail/T14112.stderr ===================================== @@ -1,5 +1,5 @@ -T14112.hs:5:21: error: +T14112.hs:5:21: error: [GHC-69317] Invalid right-hand side of bidirectional pattern synonym ‘MyJust1’: Pattern ‘!a’ is not invertible Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. ===================================== testsuite/tests/patsyn/should_fail/T14507.stderr ===================================== @@ -1,5 +1,5 @@ -T14507.hs:21:1: error: +T14507.hs:21:1: error: [GHC-88986] • Iceland Jack! Iceland Jack! Stop torturing me! Pattern-bound variable x :: TypeRep a has a type that mentions pattern-bound coercion: co ===================================== testsuite/tests/patsyn/should_fail/unidir.stderr ===================================== @@ -1,5 +1,5 @@ -unidir.hs:4:18: error: +unidir.hs:4:18: error: [GHC-69317] Invalid right-hand side of bidirectional pattern synonym ‘Head’: Pattern ‘_’ is not invertible Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. ===================================== testsuite/tests/rebindable/T18324.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE ImpredicativeTypes, DeriveAnyClass #-} +-- {-# LANGUAGE MonadComprehensions, RecursiveDo #-} +module Main where + + +type Id = forall a. a -> a + +t :: IO Id +t = return id + +p :: Id -> (Bool, Int) +p f = (f True, f 3) + +foo1 = t >>= \x -> return (p x) + +foo2 = do { x <- t ; return (p x) } + + +main = do x <- foo2 + putStrLn $ show x + ===================================== testsuite/tests/rebindable/T23147.hs ===================================== @@ -0,0 +1,27 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE QualifiedDo #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE GADTs #-} + +module T23147 where + +import qualified Control.Monad as M +import Prelude hiding (return, (>>=)) + +type Exis f = (forall r. (forall t. f t -> r) -> r) + +data Indexed t where + Indexed :: Indexed Int + +(>>=) :: Monad m => m (Exis f) -> (forall t. f t -> m (Exis g)) -> m (Exis g) +x >>= f = x M.>>= (\x' -> x' f) + +return :: Monad m => Exis f -> m (Exis f) +return = M.return + +test :: (Monad m) => Exis Indexed -> m (Exis Indexed) +test x = + T23147.do + (reified :: Indexed t) <- return x + return (\g -> g reified) ===================================== testsuite/tests/rebindable/all.T ===================================== @@ -42,3 +42,7 @@ test('T14670', expect_broken(14670), compile, ['']) test('T19167', normal, compile, ['']) test('T19918', normal, compile_and_run, ['']) test('T20126', normal, compile_fail, ['']) +# Tests for desugaring do before typechecking +test('T18324', normal, compile, ['']) +test('T23147', normal, compile, ['']) +test('pattern-fails', normal, compile, ['']) ===================================== testsuite/tests/rebindable/pattern-fails.hs ===================================== @@ -0,0 +1,18 @@ +module PF where + + +-- main :: IO () +-- main = putStrLn . show $ qqq ['c'] + +qqq :: [a] -> Maybe (a, [a]) +qqq ts = do { (a:b:as) <- Just ts + ; return (a, as) } + +newtype ST a b = ST (a, b) + +emptyST :: Maybe (ST Int Int) +emptyST = Just $ ST (0, 0) + +ppp :: Maybe (ST Int Int) -> Maybe (ST Int Int) +ppp st = do { ST (x, y) <- st + ; return $ ST (x+1, y+1)} ===================================== testsuite/tests/typecheck/should_fail/PatSynArity.hs ===================================== @@ -0,0 +1,6 @@ +{-# language PatternSynonyms #-} + +module PatSynArity where + +pattern P :: Int -> (Int, Int) +pattern P a b = (a, b) ===================================== testsuite/tests/typecheck/should_fail/PatSynArity.stderr ===================================== @@ -0,0 +1,4 @@ +PatSynArity.hs:6:1: [GHC-18365] + Pattern synonym ‘P’ has two arguments + but its type signature has 1 fewer arrows + In the declaration for pattern synonym ‘P’ ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.hs ===================================== @@ -0,0 +1,6 @@ +{-# language PatternSynonyms #-} + +module PatSynExistential where + +pattern P :: () => forall x. x -> Maybe x +pattern P <- _ ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.stderr ===================================== @@ -0,0 +1,4 @@ +PatSynExistential.hs:6:1: [GHC-33973] + The result type of the signature for ‘P’, namely ‘x -> Maybe x’ + mentions existential type variable ‘x’ + In the declaration for pattern synonym ‘P’ ===================================== testsuite/tests/typecheck/should_fail/PatSynUnboundVar.hs ===================================== @@ -0,0 +1,6 @@ +{-# language PatternSynonyms #-} + +module PatSynUnboundVar where + +pattern P :: Int -> (Int, Int) +pattern P a = (a, b) ===================================== testsuite/tests/typecheck/should_fail/PatSynUnboundVar.stderr ===================================== @@ -0,0 +1,4 @@ +PatSynUnboundVar.hs:6:15: [GHC-28572] + Invalid right-hand side of bidirectional pattern synonym ‘P’: + ‘b’ is not bound by the LHS of the pattern synonym + RHS pattern: (a, b) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -672,3 +672,6 @@ test('T22924a', normal, compile_fail, ['']) test('T22924b', normal, compile_fail, ['']) test('T22940', normal, compile_fail, ['']) test('T19627', normal, compile_fail, ['']) +test('PatSynExistential', normal, compile_fail, ['']) +test('PatSynArity', normal, compile_fail, ['']) +test('PatSynUnboundVar', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e96c807f77dd16775f34d18fa7800215504a908...849c014be1e38dfa569aab2436b531b68cc0952f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e96c807f77dd16775f34d18fa7800215504a908...849c014be1e38dfa569aab2436b531b68cc0952f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 19:51:43 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 23 Mar 2023 15:51:43 -0400 Subject: [Git][ghc/ghc][wip/expand-do] do stmt expansion for Applicative Do Message-ID: <641cadcf1be33_90da52f167181002742@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: a0f73250 by Apoorv Ingle at 2023-03-23T14:51:32-05:00 do stmt expansion for Applicative Do - - - - - 7 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - testsuite/tests/rebindable/T18324.hs - testsuite/tests/rebindable/all.T - testsuite/tests/rebindable/pattern-fails.hs - + testsuite/tests/rebindable/pattern-fails.stdout Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1077,7 +1077,7 @@ instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) -- = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) -- (ppr orig) - = ppr orig <+> braces (text "Expansion:" <+> ppr expanded) + = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -433,8 +433,7 @@ rnExpr (HsDo _ do_or_lc (L l stmts)) rnStmtsWithFreeVars (HsDoStmt do_or_lc) rnExpr stmts (\ _ -> return ((), emptyFVs)) ; (pp_stmts, fvs2) <- postProcessStmtsForApplicativeDo do_or_lc stmts1 - ; return (HsDo noExtField do_or_lc (L l pp_stmts), fvs1 `plusFV` fvs2) - } + ; return ( HsDo noExtField do_or_lc (L l pp_stmts), fvs1 `plusFV` fvs2 ) } -- ExplicitList: see Note [Handling overloaded and rebindable constructs] rnExpr (ExplicitList _ exps) = do { (exps', fvs) <- rnExprs exps @@ -1071,10 +1070,8 @@ postProcessStmtsForApplicativeDo ctxt stmts ; in_th_bracket <- isBrackStage <$> getStage ; if ado_is_on && is_do_expr && not in_th_bracket then do { traceRn "ppsfa" (ppr stmts) - ; ado_stmts_and_fvs <- rearrangeForApplicativeDo ctxt stmts - ; return ado_stmts_and_fvs } - else do { do_stmts_and_fvs <- noPostProcessStmts (HsDoStmt ctxt) stmts - ; return do_stmts_and_fvs } } + ; rearrangeForApplicativeDo ctxt stmts } + else noPostProcessStmts (HsDoStmt ctxt) stmts } -- | strip the FreeVars annotations from statements noPostProcessStmts @@ -1813,7 +1810,7 @@ independent and do something like this: (y,z) <- (,) <$> B x <*> C return (f x y z) -But this isn't enough! A and C were also independent, and this +But this isn't enough! If A and C were also independent, then this transformation loses the ability to do A and C in parallel. The algorithm works by first splitting the sequence of statements into ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -71,7 +71,8 @@ import GHC.Builtin.Names (bindMName, returnMName) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc -import GHC.Driver.Session ( getDynFlags ) +import GHC.Driver.Session ( getDynFlags, DynFlags ) +import GHC.Driver.Ppr (showPpr) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name @@ -325,7 +326,7 @@ tcDoStmts doExpr@(DoExpr _) (L l stmts) res_ty ; let expand_do_expr = mkExpandedExpr (HsDo noExtField doExpr (L l stmts)) (unLoc expand_expr) -- Do expansion on the fly - ; traceTc "tcDoStmts" (text "tcExpr:" <+> ppr expand_do_expr) + ; traceTc "tcDoStmts do" (text "tcExpr:" <+> ppr expand_do_expr) ; tcExpr expand_do_expr res_ty } @@ -337,7 +338,7 @@ tcDoStmts mDoExpr@(MDoExpr _) (L l stmts) res_ty ; let expand_do_expr = mkExpandedExpr (HsDo noExtField mDoExpr (L l stmts)) (unLoc expand_expr) -- Do expansion on the fly - ; traceTc "tcDoStmts" (text "tcExpr:" <+> ppr expand_do_expr) + ; traceTc "tcDoStmts mdo" (text "tcExpr:" <+> ppr expand_do_expr) ; tcExpr expand_do_expr res_ty } @@ -1220,8 +1221,8 @@ expand_do_stmts do_flavour [L _ (LastStmt _ body _ ret_expr)] expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) - | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn - , Just (SyntaxExprRn fail_op) <- xbsrn_failOp xbsrn = + | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn + , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding x can fail -- stmts ~~> stmt' let f pat = stmts'; f _ = fail ".." -- ------------------------------------------------------- @@ -1233,17 +1234,6 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) , expr ]) - | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn - , Nothing <- xbsrn_failOp xbsrn = -- irrefutable pattern so no failure --- stmts ~~> stmt' --- ------------------------------------------------ --- x <- e ; stmts ~~> (Prelude.>>=) e (\ x -> stmts') - do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ noLocA (foldl genHsApp bind_op -- (>>=) - [ e - , mkHsLam [pat] expand_stmts -- (\ x -> stmts') - ]) - | otherwise = -- just use the polymorhpic bindop. TODO: Necessary? do expand_stmts <- expand_do_stmts do_or_lc lstmts return $ noLocA (genHsApps bindMName -- (Prelude.>>=) @@ -1251,33 +1241,6 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) , mkHsLam [pat] expand_stmts -- (\ x -> stmts') ]) - where - mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn -> TcM (LHsExpr GhcRn) - -- checks the pattern pat and decides if we need to plug in the fail block - -- Type checking the pattern is necessary to decide if we need to generate the fail block - -- Renamer cannot always determine if a fail block is necessary, and its conservative behaviour would - -- generate a fail block even if it is not really needed. cf. GHC.Hs.isIrrefutableHsPat - -- Only Tuples are considered irrefutable in the renamer, while newtypes and TyCons with only one datacon - -- is not - mk_failable_lexpr_tcm pat lexpr fail_op = - do { ((tc_pat, _), _) <- tcInferPat (FRRBindStmt DoNotation) - PatBindRhs pat $ return id -- whatever - ; dflags <- getDynFlags - ; if isIrrefutableHsPat dflags tc_pat - then return $ mkHsLam [pat] lexpr - else return $ mk_fail_lexpr pat lexpr fail_op - } - mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn -> LHsExpr GhcRn - -- makes the fail block - -- TODO: check the discussion around MonadFail.fail type signature. - -- Should we really say `mkHsString "fail pattern"`? if yes, maybe a better error message would help - mk_fail_lexpr pat lexpr fail_op = - noLocA (HsLam noExtField $ mkMatchGroup Generated -- let - (noLocA [ mkHsCaseAlt pat lexpr -- f pat = expr - , mkHsCaseAlt nlWildPatName -- f _ = fail "fail pattern" - (noLocA $ genHsApp fail_op - (nlHsLit $ mkHsString "fail pattern")) ])) - expand_do_stmts do_or_lc (L _ (LetStmt _ bnds) : lstmts) = -- stmts ~~> stmts' -- ------------------------------------------------ @@ -1296,13 +1259,14 @@ expand_do_stmts do_or_lc ((L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = [ e -- e , expand_stmts ] -- stmts' -expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts - , recS_later_ids = later_ids -- forward referenced local ids - , recS_rec_ids = local_ids -- ids referenced outside of the rec block - , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr - , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr - -- use it explicitly - -- at the end of expanded rec block +expand_do_stmts do_or_lc + ((L _ (RecStmt { recS_stmts = rec_stmts + , recS_later_ids = later_ids -- forward referenced local ids + , recS_rec_ids = local_ids -- ids referenced outside of the rec block + , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr + , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr + -- use it explicitly + -- at the end of expanded rec block })) : lstmts) = -- See Note [Typing a RecStmt] @@ -1320,7 +1284,8 @@ expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts expand_stmts -- stmts') ]) where - local_only_ids = local_ids \\ later_ids -- get unique local rec ids; local rec ids and later ids overlap + local_only_ids = local_ids \\ later_ids -- get unique local rec ids; + --local rec ids and later ids can overlap all_ids = local_only_ids ++ later_ids -- put local ids before return ids return_stmt :: ExprLStmt GhcRn @@ -1336,13 +1301,51 @@ expand_do_stmts do_or_lc ((L _ (RecStmt { recS_stmts = rec_stmts mfix_expr :: LHsExpr GhcRn mfix_expr = mkHsLam [ mkBigLHsVarPatTup all_ids ] $ do_block -expand_do_stmts _ (stmt@(L _ (ApplicativeStmt _ appargs (Just join))):_) = --- See Note [Applicative BodyStmt] - pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" $ ppr stmt - -expand_do_stmts _ (stmt@(L _ (ApplicativeStmt _ appargs Nothing)):_) = +expand_do_stmts do_or_lc (stmt@(L _ (ApplicativeStmt _ args mb_join)): lstmts) = -- See Note [Applicative BodyStmt] - pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" $ ppr stmt +-- +-- stmts ~~> stmts' +-- ------------------------------------------------- +-- ; stmts ~~> (\ x -> stmts') <$> e1 <*> e2 ... +-- +-- Very similar to HsToCore.Expr.dsDo + +-- args are [(<$>, e1), (<*>, e2), .., ] +-- mb_join is Maybe (join) + do { expr' <- expand_do_stmts do_or_lc lstmts + ; (pats_can_fail, rhss) <- unzip <$> mapM (do_arg . snd) args + + ; body <- foldrM match_args expr' pats_can_fail -- add blocks for failable patterns + + ; let expand_ado_expr = foldl mk_app_call body (zip (map fst args) rhss) + ; traceTc "expand_do_stmts: debug" $ (vcat [ text "stmt:" <+> ppr stmt + , text "(pats,rhss):" <+> ppr (pats_can_fail, rhss) + , text "expr':" <+> ppr expr' + , text "args" <+> ppr args + , text "final_ado" <+> ppr expand_ado_expr + ]) + + + -- pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" empty + ; case mb_join of + Nothing -> return expand_ado_expr + Just NoSyntaxExprRn -> return expand_ado_expr -- this is stupid + Just (SyntaxExprRn join_op) -> return $ mkHsApp (noLocA join_op) expand_ado_expr + } + where + do_arg :: ApplicativeArg GhcRn -> TcM ((LPat GhcRn, FailOperator GhcRn), LHsExpr GhcRn) + do_arg (ApplicativeArgOne mb_fail_op pat expr _) = + return ((pat, mb_fail_op), expr) + do_arg (ApplicativeArgMany _ stmts ret pat _) = + do { expr <- expand_do_stmts do_or_lc $ stmts ++ [noLocA $ mkLastStmt (noLocA ret)] + ; return ((pat, Nothing), expr) } + + match_args :: (LPat GhcRn, FailOperator GhcRn) -> LHsExpr GhcRn -> TcM (LHsExpr GhcRn) + match_args (pat, fail_op) body = mk_failable_lexpr_tcm pat body fail_op + + mk_app_call l (op, r) = case op of + SyntaxExprRn op -> mkHsApps (noLocA op) [l, r] + NoSyntaxExprRn -> pprPanic "expand_do_stmts: impossible happened first arg" (ppr op) expand_do_stmts _ (stmt@(L _ (TransStmt {})):_) = pprPanic "expand_do_stmts: impossible happened TransStmt" $ ppr stmt @@ -1354,3 +1357,40 @@ expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = expand_do_stmts do_flavor stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr do_flavor $$ ppr stmts) + + + +mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) +-- checks the pattern pat and decides if we need to plug in the fail block +-- Type checking the pattern is necessary to decide if we need to generate the fail block +-- Renamer cannot always determine if a fail block is necessary, and its conservative behaviour would +-- generate a fail block even if it is not really needed. cf. GHC.Hs.isIrrefutableHsPat +-- Only Tuples are considered irrefutable in the renamer, while newtypes and TyCons with only one datacon +-- is not +mk_failable_lexpr_tcm pat lexpr fail_op = + do { ((tc_pat, _), _) <- tcInferPat (FRRBindStmt DoNotation) + PatBindRhs pat $ return id -- whatever + ; dflags <- getDynFlags + ; if isIrrefutableHsPat dflags tc_pat + then return $ mkHsLam [pat] lexpr + else mk_fail_lexpr pat lexpr fail_op + } + +-- makes the fail block +-- TODO: check the discussion around MonadFail.fail type signature. +-- Should we really say `mkHsString "fail pattern"`? if yes, maybe a better error message would help +mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) +mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = + do dflags <- getDynFlags + return $ noLocA (HsLam noExtField $ mkMatchGroup Generated -- \ + (noLocA [ mkHsCaseAlt pat lexpr -- pat -> expr + , mkHsCaseAlt nlWildPatName -- _ -> fail "fail pattern" + (noLocA $ genHsApp fail_op + (mk_fail_msg_expr dflags (DoExpr Nothing) pat)) + ])) +mk_fail_lexpr _ _ _ = pprPanic "mk_fail_lexpr: impossible happened" empty + +mk_fail_msg_expr :: DynFlags -> HsDoFlavour -> LPat GhcRn -> LHsExpr GhcRn +mk_fail_msg_expr dflags ctx pat + = nlHsLit $ mkHsString $ showPpr dflags $ text "Pattern match failure in" <+> pprHsDoFlavour ctx + <+> text "at" <+> ppr (getLocA pat) ===================================== testsuite/tests/rebindable/T18324.hs ===================================== @@ -19,3 +19,9 @@ foo2 = do { x <- t ; return (p x) } main = do x <- foo2 putStrLn $ show x + +data D a b = D b b | E a a + +fffgg daa = case daa of + D b1 b2 -> let + x = do ===================================== testsuite/tests/rebindable/all.T ===================================== @@ -45,4 +45,4 @@ test('T20126', normal, compile_fail, ['']) # Tests for desugaring do before typechecking test('T18324', normal, compile, ['']) test('T23147', normal, compile, ['']) -test('pattern-fails', normal, compile, ['']) +test('pattern-fails', normal, compile_and_run, ['']) ===================================== testsuite/tests/rebindable/pattern-fails.hs ===================================== @@ -1,8 +1,8 @@ -module PF where +module Main where --- main :: IO () --- main = putStrLn . show $ qqq ['c'] +main :: IO () +main = putStrLn . show $ qqq ['c'] qqq :: [a] -> Maybe (a, [a]) qqq ts = do { (a:b:as) <- Just ts @@ -16,3 +16,5 @@ emptyST = Just $ ST (0, 0) ppp :: Maybe (ST Int Int) -> Maybe (ST Int Int) ppp st = do { ST (x, y) <- st ; return $ ST (x+1, y+1)} + + ===================================== testsuite/tests/rebindable/pattern-fails.stdout ===================================== @@ -0,0 +1 @@ +Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0f732508aa4fd0fc23a6f9e51052b0413318154 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0f732508aa4fd0fc23a6f9e51052b0413318154 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 20:02:36 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 16:02:36 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 3 commits: testsuite: Add test for atomicSwapIORef Message-ID: <641cb05cc4adc_90da5365e32c10031b9@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: c726aa07 by Ben Gamari at 2023-03-23T16:02:31-04:00 testsuite: Add test for atomicSwapIORef - - - - - 7a2d5890 by Ben Gamari at 2023-03-23T16:02:31-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - 129e7ff1 by Ben Gamari at 2023-03-23T16:02:31-04:00 Make atomicSwapMutVar# an inline primop - - - - - 8 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/GHC/IORef.hs - + libraries/base/tests/AtomicSwapIORef.hs - + libraries/base/tests/AtomicSwapIORef.stdout - libraries/base/tests/all.T - rts/include/Cmm.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2513,6 +2513,12 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp + MutVar# s v -> v -> State# s -> (# State# s, v #) + {Atomically exchange the value of a 'MutVar#'.} + with + has_side_effects = True + -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -308,6 +308,10 @@ emitPrimOp cfg primop = (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutv)) mkdirtyMutVarCCall + AtomicSwapMutVarOp -> \[mutv, val] -> opIntoRegs $ \[res] -> do + let dst = cmmOffsetW platform mutv (fixedHdrSizeW profile) + emitPrimCall [res] (MO_Xchg (wordWidth platform)) [dst, val] + -- #define sizzeofByteArrayzh(r,a) \ -- r = ((StgArrBytes *)(a))->bytes SizeofByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -859,6 +859,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -127,12 +127,9 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a --- Bad implementation! This will be a primop shortly. atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicModifyMutVar2# ref (\_old -> Box new) s of - (# s', old, Box _new #) -> (# s', old #) - -data Box a = Box a + case atomicSwapMutVar# ref new s of + (# s', old #) -> (# s', old #) -- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both -- the value stored in the 'IORef' and the value returned. The new value ===================================== libraries/base/tests/AtomicSwapIORef.hs ===================================== @@ -0,0 +1,8 @@ +import Data.IORef +import GHC.IORef + +main :: IO () +main = do + r <- newIORef 42 :: IO (IORef Int) + atomicSwapIORef r 43 + readIORef r >>= print ===================================== libraries/base/tests/AtomicSwapIORef.stdout ===================================== @@ -0,0 +1 @@ +43 ===================================== libraries/base/tests/all.T ===================================== @@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('AtomicSwapIORef', normal, compile_and_run, ['']) ===================================== rts/include/Cmm.h ===================================== @@ -193,8 +193,10 @@ #if SIZEOF_W == 4 #define cmpxchgW cmpxchg32 +#define xchgW xchg32 #elif SIZEOF_W == 8 #define cmpxchgW cmpxchg64 +#define xchgW xchg64 #endif /* ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/373f22f7e8813caf26556d51978aac2669b4aaf1...129e7ff13e577c68a5084cbdb9978e1ebebbee0c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/373f22f7e8813caf26556d51978aac2669b4aaf1...129e7ff13e577c68a5084cbdb9978e1ebebbee0c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 20:14:01 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 16:14:01 -0400 Subject: [Git][ghc/ghc][wip/T22872] 92 commits: Add `Data.Functor.unzip` Message-ID: <641cb309b53c8_90da5381bbec100427d@gitlab.mail> Ben Gamari pushed to branch wip/T22872 at Glasgow Haskell Compiler / GHC Commits: fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 833413f4 by Ben Gamari at 2023-03-23T16:13:56-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToByteCode.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e1961e11457ba16eb99daa4ffd66d6fde637aeb...833413f4d85e252f88dbd1634ed2ae9c49fa8b53 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e1961e11457ba16eb99daa4ffd66d6fde637aeb...833413f4d85e252f88dbd1634ed2ae9c49fa8b53 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 21:27:10 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Thu, 23 Mar 2023 17:27:10 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/amg/T22757 Message-ID: <641cc42ebc0aa_90da54d5f9cc1010457@gitlab.mail> Adam Gundry pushed new branch wip/amg/T22757 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/amg/T22757 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 23 23:56:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 23 Mar 2023 19:56:05 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <641ce71546a47_90da57016448102525e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 5d9d7ae7 by Adam Gundry at 2023-03-23T19:56:00-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 9c76f601 by Adam Gundry at 2023-03-23T19:56:00-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - a389a6c9 by Ben Gamari at 2023-03-23T19:56:00-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 30 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/using-warnings.rst - libraries/base/Data/Functor/Compose.hs - libraries/base/changelog.md - testsuite/tests/parser/should_compile/T3303.stderr - testsuite/tests/patsyn/should_fail/T14112.stderr - testsuite/tests/patsyn/should_fail/T14507.stderr - testsuite/tests/patsyn/should_fail/unidir.stderr - testsuite/tests/rename/should_compile/T5867.stderr - testsuite/tests/rename/should_compile/rn050.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b15ff2af14e006447a5afb5c101b4fafc60548e3...a389a6c91ccdeba47781149373f6c826a818068d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b15ff2af14e006447a5afb5c101b4fafc60548e3...a389a6c91ccdeba47781149373f6c826a818068d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 01:57:53 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 21:57:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/export-finaliser-exceptions Message-ID: <641d03a1e3905_90da591f855c10334e6@gitlab.mail> Ben Gamari pushed new branch wip/export-finaliser-exceptions at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/export-finaliser-exceptions You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 01:58:04 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 21:58:04 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23160 Message-ID: <641d03acd752f_90da59202c64103367a@gitlab.mail> Ben Gamari pushed new branch wip/T23160 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23160 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 02:11:15 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 22:11:15 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22706 Message-ID: <641d06c387158_90da59202cc81037533@gitlab.mail> Ben Gamari pushed new branch wip/T22706 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22706 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 02:13:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 22:13:58 -0400 Subject: [Git][ghc/ghc][wip/T22706] base: Export GHC.Conc.Sync.fromThreadId Message-ID: <641d07661c9a6_90da5992e0101039512@gitlab.mail> Ben Gamari pushed to branch wip/T22706 at Glasgow Haskell Compiler / GHC Commits: 2dfb34dd by Ben Gamari at 2023-03-23T22:13:49-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 2 changed files: - libraries/base/GHC/Conc/Sync.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -33,6 +33,7 @@ module GHC.Conc.Sync ( -- * Threads ThreadId(..) + , fromThreadId , showThreadId , myThreadId , killThread @@ -152,11 +153,18 @@ This misfeature will hopefully be corrected at a later date. -} +-- | Map a thread to an integer identifier which is unique within the +-- current process. +-- +-- @since 4.19.0.0 +fromThreadId :: ThreadId -> Word64 +fromThreadId = fromIntegral . getThreadId + -- | @since 4.2.0.0 instance Show ThreadId where showsPrec d t = showParen (d >= 11) $ showString "ThreadId " . - showsPrec d (getThreadId (id2TSO t)) + showsPrec d (fromThreadId t) showThreadId :: ThreadId -> String showThreadId = show ===================================== libraries/base/changelog.md ===================================== @@ -1,6 +1,8 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) ## 4.19.0.0 *TBA* + + * `GHC.Conc.Sync` now exports `fromThreadId :: ThreadId -> Word64`, which maps a thread to a per-process-unique identifier ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) * Add `Data.List.!?` ([CLC proposal #110](https://github.com/haskell/core-libraries-committee/issues/110)) * `maximumBy`/`minimumBy` are now marked as `INLINE` improving performance for unpackable types significantly. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2dfb34dd7d1cdd1c1c362a3efe57473d27856001 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2dfb34dd7d1cdd1c1c362a3efe57473d27856001 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 02:30:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 22:30:34 -0400 Subject: [Git][ghc/ghc][wip/T22706] base: Export GHC.Conc.Sync.fromThreadId Message-ID: <641d0b4a38073_90da59cae02810450f1@gitlab.mail> Ben Gamari pushed to branch wip/T22706 at Glasgow Haskell Compiler / GHC Commits: c149ab57 by Ben Gamari at 2023-03-23T22:30:30-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 2 changed files: - libraries/base/GHC/Conc/Sync.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -33,6 +33,7 @@ module GHC.Conc.Sync ( -- * Threads ThreadId(..) + , fromThreadId , showThreadId , myThreadId , killThread @@ -152,11 +153,18 @@ This misfeature will hopefully be corrected at a later date. -} +-- | Map a thread to an integer identifier which is unique within the +-- current process. +-- +-- @since 4.19.0.0 +fromThreadId :: ThreadId -> Word64 +fromThreadId = fromIntegral . getThreadId + -- | @since 4.2.0.0 instance Show ThreadId where showsPrec d t = showParen (d >= 11) $ showString "ThreadId " . - showsPrec d (getThreadId (id2TSO t)) + showsPrec d (fromThreadId t) showThreadId :: ThreadId -> String showThreadId = show ===================================== libraries/base/changelog.md ===================================== @@ -1,6 +1,8 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) ## 4.19.0.0 *TBA* + + * `GHC.Conc.Sync` now exports `fromThreadId :: ThreadId -> Word64`, which maps a thread to a per-process-unique identifier ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) * Add `Data.List.!?` ([CLC proposal #110](https://github.com/haskell/core-libraries-committee/issues/110)) * `maximumBy`/`minimumBy` are now marked as `INLINE` improving performance for unpackable types significantly. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c149ab5701be0df979f104a86804a017cd3df7cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c149ab5701be0df979f104a86804a017cd3df7cd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 02:31:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 22:31:25 -0400 Subject: [Git][ghc/ghc][wip/T23096] codeGen/tsan: Disable instrumentation of unaligned stores Message-ID: <641d0b7d3e505_90da59ee9d38104541a@gitlab.mail> Ben Gamari pushed to branch wip/T23096 at Glasgow Haskell Compiler / GHC Commits: 038e0e89 by Ben Gamari at 2023-03-23T22:31:18-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 1 changed file: - compiler/GHC/Cmm/ThreadSanitizer.hs Changes: ===================================== compiler/GHC/Cmm/ThreadSanitizer.hs ===================================== @@ -54,11 +54,13 @@ annotateNode env node = CmmTick{} -> BMiddle node CmmUnwind{} -> BMiddle node CmmAssign{} -> annotateNodeOO env node - CmmStore lhs rhs align -> + -- TODO: Track unaligned stores + CmmStore _ _ Unaligned -> annotateNodeOO env node + CmmStore lhs rhs NaturallyAligned -> let ty = cmmExprType (platform env) rhs rhs_nodes = annotateLoads env (collectExprLoads rhs) lhs_nodes = annotateLoads env (collectExprLoads lhs) - st = tsanStore env align ty lhs + st = tsanStore env ty lhs in rhs_nodes `blockAppend` lhs_nodes `blockAppend` st `blockSnoc` node CmmUnsafeForeignCall (PrimTarget op) formals args -> let node' = fromMaybe (BMiddle node) (annotatePrim env op formals args) @@ -197,17 +199,14 @@ tsanTarget fn formals args = lbl = mkForeignLabel fn Nothing ForeignLabelInExternalPackage IsFunction tsanStore :: Env - -> AlignmentSpec -> CmmType -> CmmExpr + -> CmmType -> CmmExpr -> Block CmmNode O O -tsanStore env align ty addr = +tsanStore env ty addr = mkUnsafeCall env ftarget [] [addr] where ftarget = tsanTarget fn [] [AddrHint] w = widthInBytes (typeWidth ty) - fn = case align of - Unaligned - | w > 1 -> fsLit $ "__tsan_unaligned_write" ++ show w - _ -> fsLit $ "__tsan_write" ++ show w + fn = fsLit $ "__tsan_write" ++ show w tsanLoad :: Env -> AlignmentSpec -> CmmType -> CmmExpr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/038e0e89b0f604bad2c69c29e9b86ffd8103516a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/038e0e89b0f604bad2c69c29e9b86ffd8103516a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 02:34:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 22:34:06 -0400 Subject: [Git][ghc/ghc][wip/rts-warnings] 205 commits: Add clangd flag to include generated header files Message-ID: <641d0c1e47998_90da5a0a777410508df@gitlab.mail> Ben Gamari pushed to branch wip/rts-warnings at Glasgow Haskell Compiler / GHC Commits: 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 2dc5a1d1 by Ben Gamari at 2023-03-23T22:33:20-04:00 rts/ipe: Fix unused lock warning - - - - - 1b711b85 by Ben Gamari at 2023-03-23T22:33:20-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 6818780b by Ben Gamari at 2023-03-23T22:33:56-04:00 rts: Various warnings fixes - - - - - d6a38e96 by Ben Gamari at 2023-03-23T22:33:57-04:00 rts: Fix printf format mismatch - - - - - 0d384dbb by Ben Gamari at 2023-03-23T22:33:57-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - 7c560927 by Ben Gamari at 2023-03-23T22:33:57-04:00 nonmoving: Fix unused definition warrnings - - - - - c872de29 by Ben Gamari at 2023-03-23T22:33:57-04:00 Disable futimens on Darwin. See #22938 - - - - - f3c79d80 by Ben Gamari at 2023-03-23T22:33:57-04:00 rts: Fix incorrect CPP guard - - - - - 0b04679a by Ben Gamari at 2023-03-23T22:33:57-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - cabal.project-reinstall - compile_flags.txt - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Class.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e594159d6f40c4d7e2230bb9ac92204f221bd9f7...0b04679afb1418620cf0ff059eca6fdf16b7f7d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e594159d6f40c4d7e2230bb9ac92204f221bd9f7...0b04679afb1418620cf0ff059eca6fdf16b7f7d3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 02:41:32 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 23 Mar 2023 22:41:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23170 Message-ID: <641d0ddcb1515_90da5a3b30a8105153c@gitlab.mail> Ben Gamari pushed new branch wip/T23170 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23170 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 04:11:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 24 Mar 2023 00:11:44 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 7 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <641d230086039_90da5ba5f950106216f@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 4f32b5e5 by Ben Gamari at 2023-03-24T00:00:27-04:00 testsuite: Add test for atomicSwapIORef - - - - - cf7678b8 by Ben Gamari at 2023-03-24T00:10:17-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - 27 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Error/Codes.hs - libraries/base/Data/Functor/Compose.hs - libraries/base/GHC/IORef.hs - libraries/base/changelog.md - + libraries/base/tests/AtomicSwapIORef.hs - + libraries/base/tests/AtomicSwapIORef.stdout - libraries/base/tests/all.T - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/include/Cmm.h - rts/include/stg/MiscClosures.h - testsuite/tests/patsyn/should_fail/T14112.stderr - testsuite/tests/patsyn/should_fail/T14507.stderr - testsuite/tests/patsyn/should_fail/unidir.stderr - + testsuite/tests/typecheck/should_fail/PatSynArity.hs - + testsuite/tests/typecheck/should_fail/PatSynArity.stderr - + testsuite/tests/typecheck/should_fail/PatSynExistential.hs - + testsuite/tests/typecheck/should_fail/PatSynExistential.stderr - + testsuite/tests/typecheck/should_fail/PatSynUnboundVar.hs - + testsuite/tests/typecheck/should_fail/PatSynUnboundVar.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2513,6 +2513,13 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp + MutVar# s v -> v -> State# s -> (# State# s, v #) + {Atomically exchange the value of a 'MutVar#'.} + with + out_of_line = True + has_side_effects = True + -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1559,6 +1559,7 @@ emitPrimOp cfg primop = ResizeMutableByteArrayOp_Char -> alwaysExternal ShrinkSmallMutableArrayOp_Char -> alwaysExternal NewMutVarOp -> alwaysExternal + AtomicSwapMutVarOp -> alwaysExternal AtomicModifyMutVar2Op -> alwaysExternal AtomicModifyMutVar_Op -> alwaysExternal CasMutVarOp -> alwaysExternal ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -859,6 +859,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1481,6 +1481,32 @@ instance Diagnostic TcRnMessage where , text "(Indeed, I sometimes struggle even printing this correctly," , text " due to its ill-scoped nature.)" ] + TcRnPatSynEscapedCoercion arg bad_co_ne -> mkSimpleDecorated $ + vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" + , hang (text "Pattern-bound variable") + 2 (ppr arg <+> dcolon <+> ppr (idType arg)) + , nest 2 $ + hang (text "has a type that mentions pattern-bound coercion" + <> plural bad_co_list <> colon) + 2 (pprWithCommas ppr bad_co_list) + , text "Hint: use -fprint-explicit-coercions to see the coercions" + , text "Probable fix: add a pattern signature" ] + where + bad_co_list = NE.toList bad_co_ne + TcRnPatSynExistentialInResult name pat_ty bad_tvs -> mkSimpleDecorated $ + hang (sep [ text "The result type of the signature for" <+> quotes (ppr name) <> comma + , text "namely" <+> quotes (ppr pat_ty) ]) + 2 (text "mentions existential type variable" <> plural bad_tvs + <+> pprQuotedList bad_tvs) + TcRnPatSynArityMismatch name decl_arity missing -> mkSimpleDecorated $ + hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" + <+> speakNOf decl_arity (text "argument")) + 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows") + TcRnPatSynInvalidRhs ps_name lpat args reason -> mkSimpleDecorated $ + vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" + <+> quotes (ppr ps_name) <> colon) + 2 (pprPatSynInvalidRhsReason ps_name lpat args reason) + , text "RHS pattern:" <+> ppr lpat ] diagnosticReason = \case TcRnUnknownMessage m @@ -1965,6 +1991,14 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnSkolemEscape{} -> ErrorWithoutFlag + TcRnPatSynEscapedCoercion{} + -> ErrorWithoutFlag + TcRnPatSynExistentialInResult{} + -> ErrorWithoutFlag + TcRnPatSynArityMismatch{} + -> ErrorWithoutFlag + TcRnPatSynInvalidRhs{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2467,6 +2501,14 @@ instance Diagnostic TcRnMessage where -> noHints TcRnSkolemEscape{} -> noHints + TcRnPatSynEscapedCoercion{} + -> noHints + TcRnPatSynExistentialInResult{} + -> noHints + TcRnPatSynArityMismatch{} + -> noHints + TcRnPatSynInvalidRhs{} + -> noHints diagnosticCode = constructorCode @@ -4561,3 +4603,18 @@ pprUninferrableTyvarCtx = \case UninfTyCtx_Sig exp_kind full_hs_ty -> hang (text "the kind" <+> ppr exp_kind) 2 (text "of the type signature:" <+> ppr full_hs_ty) + +pprPatSynInvalidRhsReason :: Name -> LPat GhcRn -> [LIdP GhcRn] -> PatSynInvalidRhsReason -> SDoc +pprPatSynInvalidRhsReason name pat args = \case + PatSynNotInvertible p -> + text "Pattern" <+> quotes (ppr p) <+> text "is not invertible" + $+$ hang (text "Suggestion: instead use an explicitly bidirectional" + <+> text "pattern synonym, e.g.") + 2 (hang (text "pattern" <+> pp_name <+> pp_args <+> larrow + <+> ppr pat <+> text "where") + 2 (pp_name <+> pp_args <+> equals <+> text "...")) + where + pp_name = ppr name + pp_args = hsep (map ppr args) + PatSynUnboundVar var -> + quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym" ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -95,6 +95,7 @@ module GHC.Tc.Errors.Types ( , WrongThingSort(..) , StageCheckReason(..) , UninferrableTyvarCtx(..) + , PatSynInvalidRhsReason(..) ) where import GHC.Prelude @@ -108,7 +109,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , UserTypeCtxt (PatSynCtxt), TyVarBndrs, TypedThing , FixedRuntimeRepOrigin(..), InstanceWhat ) import GHC.Tc.Types.Rank (Rank) -import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType) +import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType, TcSigmaType) import GHC.Types.Avail (AvailInfo) import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) @@ -118,7 +119,7 @@ import qualified GHC.Types.Name.Occurrence as OccName import GHC.Types.Name.Reader import GHC.Types.SrcLoc import GHC.Types.TyThing (TyThing) -import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar) +import GHC.Types.Var (Id, TyCoVar, TyVar, TcTyVar, CoVar) import GHC.Types.Var.Env (TidyEnv) import GHC.Types.Var.Set (TyVarSet, VarSet) import GHC.Unit.Types (Module) @@ -3293,6 +3294,52 @@ data TcRnMessage where -> !Type -- ^ The type in which they occur. -> TcRnMessage + {-| TcRnPatSynEscapedCoercion is an error indicating that a coercion escaped from + a pattern synonym into a type. + See Note [Coercions that escape] in GHC.Tc.TyCl.PatSyn + + Test cases: + T14507 + -} + TcRnPatSynEscapedCoercion :: !Id -- ^ The pattern-bound variable + -> !(NE.NonEmpty CoVar) -- ^ The escaped coercions + -> TcRnMessage + + {-| TcRnPatSynExistentialInResult is an error indicating that the result type + of a pattern synonym mentions an existential type variable. + + Test cases: + PatSynExistential + -} + TcRnPatSynExistentialInResult :: !Name -- ^ The name of the pattern synonym + -> !TcSigmaType -- ^ The result type + -> ![TyVar] -- ^ The escaped existential variables + -> TcRnMessage + + {-| TcRnPatSynArityMismatch is an error indicating that the number of arguments in a + pattern synonym's equation differs from the number of parameters in its + signature. + + Test cases: + PatSynArity + -} + TcRnPatSynArityMismatch :: !Name -- ^ The name of the pattern synonym + -> !Arity -- ^ The number of equation arguments + -> !Arity -- ^ The difference + -> TcRnMessage + + {-| TcRnPatSynInvalidRhs is an error group indicating that the pattern on the + right hand side of a pattern synonym is invalid. + + Test cases: + unidir, T14112 + -} + TcRnPatSynInvalidRhs :: !Name -- ^ The name of the pattern synonym + -> !(LPat GhcRn) -- ^ The pattern + -> ![LIdP GhcRn] -- ^ The LHS args + -> !PatSynInvalidRhsReason -- ^ The number of equation arguments + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -4582,3 +4629,8 @@ data UninferrableTyvarCtx | UninfTyCtx_TyfamRhs TcType | UninfTyCtx_TysynRhs TcType | UninfTyCtx_Sig TcType (LHsSigType GhcRn) + +data PatSynInvalidRhsReason + = PatSynNotInvertible !(Pat GhcRn) + | PatSynUnboundVar !Name + deriving (Generic) ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -41,7 +41,6 @@ import GHC.Core.TyCo.Subst( extendTvSubstWithClone ) import GHC.Core.Predicate import GHC.Builtin.Types.Prim -import GHC.Types.Error import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.SrcLoc @@ -68,6 +67,7 @@ import GHC.Driver.Session ( getDynFlags, xopt_FieldSelectors ) import Data.Maybe( mapMaybe ) import Control.Monad ( zipWithM ) import Data.List( partition, mapAccumL ) +import Data.List.NonEmpty (NonEmpty, nonEmpty) {- ************************************************************************ @@ -185,10 +185,11 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details -- Report coercions that escape -- See Note [Coercions that escape] ; args <- mapM zonkId args - ; let bad_args = [ (arg, bad_cos) | arg <- args ++ prov_dicts - , let bad_cos = filterDVarSet isId $ - (tyCoVarsOfTypeDSet (idType arg)) - , not (isEmptyDVarSet bad_cos) ] + ; let bad_arg arg = fmap (\bad_cos -> (arg, bad_cos)) $ + nonEmpty $ + dVarSetElems $ + filterDVarSet isId (tyCoVarsOfTypeDSet (idType arg)) + bad_args = mapMaybe bad_arg (args ++ prov_dicts) ; mapM_ dependentArgErr bad_args -- Report un-quantifiable type variables: @@ -236,22 +237,11 @@ mkProvEvidence ev_id pred = evVarPred ev_id eq_con_args = [evId ev_id] -dependentArgErr :: (Id, DTyCoVarSet) -> TcM () +dependentArgErr :: (Id, NonEmpty CoVar) -> TcM () -- See Note [Coercions that escape] dependentArgErr (arg, bad_cos) = failWithTc $ -- fail here: otherwise we get downstream errors - mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" - , hang (text "Pattern-bound variable") - 2 (ppr arg <+> dcolon <+> ppr (idType arg)) - , nest 2 $ - hang (text "has a type that mentions pattern-bound coercion" - <> plural bad_co_list <> colon) - 2 (pprWithCommas ppr bad_co_list) - , text "Hint: use -fprint-explicit-coercions to see the coercions" - , text "Probable fix: add a pattern signature" ] - where - bad_co_list = dVarSetElems bad_cos + TcRnPatSynEscapedCoercion arg bad_cos {- Note [Type variables whose kind is captured] ~~-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -405,11 +395,7 @@ tcCheckPatSynDecl psb at PSB{ psb_id = lname@(L _ name), psb_args = details -- The existential 'x' should not appear in the result type -- Can't check this until we know P's arity (decl_arity above) ; let bad_tvs = filter (`elemVarSet` tyCoVarsOfType pat_ty) $ binderVars explicit_ex_bndrs - ; checkTc (null bad_tvs) $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (sep [ text "The result type of the signature for" <+> quotes (ppr name) <> comma - , text "namely" <+> quotes (ppr pat_ty) ]) - 2 (text "mentions existential type variable" <> plural bad_tvs - <+> pprQuotedList bad_tvs) + ; checkTc (null bad_tvs) $ TcRnPatSynExistentialInResult name pat_ty bad_tvs -- See Note [The pattern-synonym signature splitting rule] in GHC.Tc.Gen.Sig ; let univ_fvs = closeOverKinds $ @@ -679,10 +665,7 @@ collectPatSynArgInfo details = wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a wrongNumberOfParmsErr name decl_arity missing - = failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" - <+> speakNOf decl_arity (text "argument")) - 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows") + = failWithTc $ TcRnPatSynArityMismatch name decl_arity missing ------------------------- -- Shared by both tcInferPatSyn and tcCheckPatSyn @@ -921,11 +904,7 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) = return emptyBag | Left why <- mb_match_group -- Can't invert the pattern - = setSrcSpan (getLocA lpat) $ failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" - <+> quotes (ppr ps_name) <> colon) - 2 why - , text "RHS pattern:" <+> ppr lpat ] + = setSrcSpan (getLocA lpat) $ failWithTc $ TcRnPatSynInvalidRhs ps_name lpat args why | Right match_group <- mb_match_group -- Bidirectional = do { patsyn <- tcLookupPatSyn ps_name @@ -975,7 +954,7 @@ tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name) mb_match_group = case dir of ExplicitBidirectional explicit_mg -> Right explicit_mg - ImplicitBidirectional -> fmap mk_mg (tcPatToExpr ps_name args lpat) + ImplicitBidirectional -> fmap mk_mg (tcPatToExpr args lpat) Unidirectional -> panic "tcPatSynBuilderBind" mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn) @@ -1019,8 +998,8 @@ add_void need_dummy_arg ty | need_dummy_arg = mkVisFunTyMany unboxedUnitTy ty | otherwise = ty -tcPatToExpr :: Name -> [LocatedN Name] -> LPat GhcRn - -> Either SDoc (LHsExpr GhcRn) +tcPatToExpr :: [LocatedN Name] -> LPat GhcRn + -> Either PatSynInvalidRhsReason (LHsExpr GhcRn) -- Given a /pattern/, return an /expression/ that builds a value -- that matches the pattern. E.g. if the pattern is (Just [x]), -- the expression is (Just [x]). They look the same, but the @@ -1029,13 +1008,13 @@ tcPatToExpr :: Name -> [LocatedN Name] -> LPat GhcRn -- -- Returns (Left r) if the pattern is not invertible, for reason r. -- See Note [Builder for a bidirectional pattern synonym] -tcPatToExpr name args pat = go pat +tcPatToExpr args pat = go pat where lhsVars = mkNameSet (map unLoc args) -- Make a prefix con for prefix and infix patterns for simplicity mkPrefixConExpr :: LocatedN Name -> [LPat GhcRn] - -> Either SDoc (HsExpr GhcRn) + -> Either PatSynInvalidRhsReason (HsExpr GhcRn) mkPrefixConExpr lcon@(L loc _) pats = do { exprs <- mapM go pats ; let con = L (l2l loc) (HsVar noExtField lcon) @@ -1043,18 +1022,18 @@ tcPatToExpr name args pat = go pat } mkRecordConExpr :: LocatedN Name -> HsRecFields GhcRn (LPat GhcRn) - -> Either SDoc (HsExpr GhcRn) + -> Either PatSynInvalidRhsReason (HsExpr GhcRn) mkRecordConExpr con (HsRecFields fields dd) = do { exprFields <- mapM go' fields ; return (RecordCon noExtField con (HsRecFields exprFields dd)) } - go' :: LHsRecField GhcRn (LPat GhcRn) -> Either SDoc (LHsRecField GhcRn (LHsExpr GhcRn)) + go' :: LHsRecField GhcRn (LPat GhcRn) -> Either PatSynInvalidRhsReason (LHsRecField GhcRn (LHsExpr GhcRn)) go' (L l rf) = L l <$> traverse go rf - go :: LPat GhcRn -> Either SDoc (LHsExpr GhcRn) + go :: LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn) go (L loc p) = L loc <$> go1 p - go1 :: Pat GhcRn -> Either SDoc (HsExpr GhcRn) + go1 :: Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn) go1 (ConPat NoExtField con info) = case info of PrefixCon _ ps -> mkPrefixConExpr con ps @@ -1068,7 +1047,7 @@ tcPatToExpr name args pat = go pat | var `elemNameSet` lhsVars = return $ HsVar noExtField (L l var) | otherwise - = Left (quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym") + = Left (PatSynUnboundVar var) go1 (ParPat _ lpar pat rpar) = fmap (\e -> HsPar noAnn lpar e rpar) $ go pat go1 (ListPat _ pats) = do { exprs <- mapM go pats @@ -1105,19 +1084,7 @@ tcPatToExpr name args pat = go pat go1 p@(AsPat {}) = notInvertible p go1 p@(NPlusKPat {}) = notInvertible p - notInvertible p = Left (not_invertible_msg p) - - not_invertible_msg p - = text "Pattern" <+> quotes (ppr p) <+> text "is not invertible" - $+$ hang (text "Suggestion: instead use an explicitly bidirectional" - <+> text "pattern synonym, e.g.") - 2 (hang (text "pattern" <+> pp_name <+> pp_args <+> larrow - <+> ppr pat <+> text "where") - 2 (pp_name <+> pp_args <+> equals <+> text "...")) - where - pp_name = ppr name - pp_args = hsep (map ppr args) - + notInvertible p = Left (PatSynNotInvertible p) {- Note [Builder for a bidirectional pattern synonym] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -542,6 +542,11 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnCannotDefaultKindVar" = 79924 GhcDiagnosticCode "TcRnUninferrableTyvar" = 16220 GhcDiagnosticCode "TcRnSkolemEscape" = 71451 + GhcDiagnosticCode "TcRnPatSynEscapedCoercion" = 88986 + GhcDiagnosticCode "TcRnPatSynExistentialInResult" = 33973 + GhcDiagnosticCode "TcRnPatSynArityMismatch" = 18365 + GhcDiagnosticCode "PatSynNotInvertible" = 69317 + GhcDiagnosticCode "PatSynUnboundVar" = 28572 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 @@ -711,6 +716,7 @@ type family ConRecursInto con where ConRecursInto "TcRnNotInScope" = 'Just NotInScopeError ConRecursInto "TcRnIllegalNewtype" = 'Just IllegalNewtypeReason ConRecursInto "TcRnHsigShapeMismatch" = 'Just HsigShapeMismatchReason + ConRecursInto "TcRnPatSynInvalidRhs" = 'Just PatSynInvalidRhsReason -- -- TH errors ===================================== libraries/base/Data/Functor/Compose.hs ===================================== @@ -31,6 +31,8 @@ import Data.Functor.Classes import Control.Applicative import Data.Coerce (coerce) import Data.Data (Data) +import Data.Foldable (Foldable(..)) +import Data.Monoid (Sum(..), All(..), Any(..), Product(..)) import Data.Type.Equality (TestEquality(..), (:~:)(..)) import GHC.Generics (Generic, Generic1) import Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault) @@ -111,7 +113,23 @@ instance (Functor f, Functor g) => Functor (Compose f g) where -- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Compose f g) where + fold (Compose t) = foldMap fold t foldMap f (Compose t) = foldMap (foldMap f) t + foldMap' f (Compose t) = foldMap' (foldMap' f) t + foldr f b (Compose fga) = foldr (\ga acc -> foldr f acc ga) b fga + foldr' f b (Compose fga) = foldr' (\ga acc -> foldr' f acc ga) b fga + foldl f b (Compose fga) = foldl (\acc ga -> foldl f acc ga) b fga + foldl' f b (Compose fga) = foldl' (\acc ga -> foldl' f acc ga) b fga + + null (Compose t) = null t || getAll (foldMap (All . null) t) + length (Compose t) = getSum (foldMap' (Sum . length) t) + elem x (Compose t) = getAny (foldMap (Any . elem x) t) + + minimum (Compose fga) = minimum $ map minimum $ filter (not . null) $ toList fga + maximum (Compose fga) = maximum $ map maximum $ filter (not . null) $ toList fga + + sum (Compose t) = getSum (foldMap' (Sum . sum) t) + product (Compose t) = getProduct (foldMap' (Product . product) t) -- | @since 4.9.0.0 instance (Traversable f, Traversable g) => Traversable (Compose f g) where ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -127,12 +127,9 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a --- Bad implementation! This will be a primop shortly. atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicModifyMutVar2# ref (\_old -> Box new) s of - (# s', old, Box _new #) -> (# s', old #) - -data Box a = Box a + case atomicSwapMutVar# ref new s of + (# s', old #) -> (# s', old #) -- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both -- the value stored in the 'IORef' and the value returned. The new value ===================================== libraries/base/changelog.md ===================================== @@ -12,6 +12,8 @@ * Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions. ([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98)) * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) + * Implement more members of `instance Foldable (Compose f g)` explicitly. + ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) ## 4.18.0.0 *TBA* ===================================== libraries/base/tests/AtomicSwapIORef.hs ===================================== @@ -0,0 +1,8 @@ +import Data.IORef +import GHC.IORef + +main :: IO () +main = do + r <- newIORef 42 :: IO (IORef Int) + mapM (atomicSwapIORef r) [0..1000] >>= print + readIORef r >>= print ===================================== libraries/base/tests/AtomicSwapIORef.stdout ===================================== @@ -0,0 +1,2 @@ +[42,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299,300,301,302,303,304,305,306,307,308,309,310,311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326,327,328,329,330,331,332,333,334,335,336,337,338,339,340,341,342,343,344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359,360,361,362,363,364,365,366,367,368,369,370,371,372,373,374,375,376,377,378,379,380,381,382,383,384,385,386,387,388,389,390,391,392,393,394,395,396,397,398,399,400,401,402,403,404,405,406,407,408,409,410,411,412,413,414,415,416,417,418,419,420,421,422,423,424,425,426,427,428,429,430,431,432,433,434,435,436,437,438,439,440,441,442,443,444,445,446,447,448,449,450,451,452,453,454,455,456,457,458,459,460,461,462,463,464,465,466,467,468,469,470,471,472,473,474,475,476,477,478,479,480,481,482,483,484,485,486,487,488,489,490,491,492,493,494,495,496,497,498,499,500,501,502,503,504,505,506,507,508,509,510,511,512,513,514,515,516,517,518,519,520,521,522,523,524,525,526,527,528,529,530,531,532,533,534,535,536,537,538,539,540,541,542,543,544,545,546,547,548,549,550,551,552,553,554,555,556,557,558,559,560,561,562,563,564,565,566,567,568,569,570,571,572,573,574,575,576,577,578,579,580,581,582,583,584,585,586,587,588,589,590,591,592,593,594,595,596,597,598,599,600,601,602,603,604,605,606,607,608,609,610,611,612,613,614,615,616,617,618,619,620,621,622,623,624,625,626,627,628,629,630,631,632,633,634,635,636,637,638,639,640,641,642,643,644,645,646,647,648,649,650,651,652,653,654,655,656,657,658,659,660,661,662,663,664,665,666,667,668,669,670,671,672,673,674,675,676,677,678,679,680,681,682,683,684,685,686,687,688,689,690,691,692,693,694,695,696,697,698,699,700,701,702,703,704,705,706,707,708,709,710,711,712,713,714,715,716,717,718,719,720,721,722,723,724,725,726,727,728,729,730,731,732,733,734,735,736,737,738,739,740,741,742,743,744,745,746,747,748,749,750,751,752,753,754,755,756,757,758,759,760,761,762,763,764,765,766,767,768,769,770,771,772,773,774,775,776,777,778,779,780,781,782,783,784,785,786,787,788,789,790,791,792,793,794,795,796,797,798,799,800,801,802,803,804,805,806,807,808,809,810,811,812,813,814,815,816,817,818,819,820,821,822,823,824,825,826,827,828,829,830,831,832,833,834,835,836,837,838,839,840,841,842,843,844,845,846,847,848,849,850,851,852,853,854,855,856,857,858,859,860,861,862,863,864,865,866,867,868,869,870,871,872,873,874,875,876,877,878,879,880,881,882,883,884,885,886,887,888,889,890,891,892,893,894,895,896,897,898,899,900,901,902,903,904,905,906,907,908,909,910,911,912,913,914,915,916,917,918,919,920,921,922,923,924,925,926,927,928,929,930,931,932,933,934,935,936,937,938,939,940,941,942,943,944,945,946,947,948,949,950,951,952,953,954,955,956,957,958,959,960,961,962,963,964,965,966,967,968,969,970,971,972,973,974,975,976,977,978,979,980,981,982,983,984,985,986,987,988,989,990,991,992,993,994,995,996,997,998,999] +1000 ===================================== libraries/base/tests/all.T ===================================== @@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('AtomicSwapIORef', normal, compile_and_run, ['']) ===================================== rts/PrimOps.cmm ===================================== @@ -689,6 +689,17 @@ stg_newMutVarzh ( gcptr init ) return (mv); } +stg_atomicSwapMutVarzh ( gcptr mv, gcptr new ) + /* MutVar# s a -> a -> State# s -> (# State#, a #) */ +{ + W_ old; + (old) = prim %xchgW(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, old); + if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) { + ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr", old "ptr"); + } + return (old); +} + // RRN: To support the "ticketed" approach, we return the NEW rather // than old value if the CAS is successful. This is received in an // opaque form in the Haskell code, preventing the compiler from ===================================== rts/RtsSymbols.c ===================================== @@ -633,6 +633,7 @@ extern char **environ; SymI_HasDataProto(stg_writeIOPortzh) \ SymI_HasDataProto(stg_newIOPortzh) \ SymI_HasDataProto(stg_noDuplicatezh) \ + SymI_HasDataProto(stg_atomicSwapMutVarzh) \ SymI_HasDataProto(stg_atomicModifyMutVar2zh) \ SymI_HasDataProto(stg_atomicModifyMutVarzuzh) \ SymI_HasDataProto(stg_casMutVarzh) \ ===================================== rts/include/Cmm.h ===================================== @@ -193,8 +193,10 @@ #if SIZEOF_W == 4 #define cmpxchgW cmpxchg32 +#define xchgW xchg32 #elif SIZEOF_W == 8 #define cmpxchgW cmpxchg64 +#define xchgW xchg64 #endif /* ----------------------------------------------------------------------------- ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -481,6 +481,7 @@ RTS_FUN_DECL(stg_copySmallMutableArrayzh); RTS_FUN_DECL(stg_casSmallArrayzh); RTS_FUN_DECL(stg_newMutVarzh); +RTS_FUN_DECL(stg_atomicSwapMutVarzh); RTS_FUN_DECL(stg_atomicModifyMutVar2zh); RTS_FUN_DECL(stg_atomicModifyMutVarzuzh); RTS_FUN_DECL(stg_casMutVarzh); ===================================== testsuite/tests/patsyn/should_fail/T14112.stderr ===================================== @@ -1,5 +1,5 @@ -T14112.hs:5:21: error: +T14112.hs:5:21: error: [GHC-69317] Invalid right-hand side of bidirectional pattern synonym ‘MyJust1’: Pattern ‘!a’ is not invertible Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. ===================================== testsuite/tests/patsyn/should_fail/T14507.stderr ===================================== @@ -1,5 +1,5 @@ -T14507.hs:21:1: error: +T14507.hs:21:1: error: [GHC-88986] • Iceland Jack! Iceland Jack! Stop torturing me! Pattern-bound variable x :: TypeRep a has a type that mentions pattern-bound coercion: co ===================================== testsuite/tests/patsyn/should_fail/unidir.stderr ===================================== @@ -1,5 +1,5 @@ -unidir.hs:4:18: error: +unidir.hs:4:18: error: [GHC-69317] Invalid right-hand side of bidirectional pattern synonym ‘Head’: Pattern ‘_’ is not invertible Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. ===================================== testsuite/tests/typecheck/should_fail/PatSynArity.hs ===================================== @@ -0,0 +1,6 @@ +{-# language PatternSynonyms #-} + +module PatSynArity where + +pattern P :: Int -> (Int, Int) +pattern P a b = (a, b) ===================================== testsuite/tests/typecheck/should_fail/PatSynArity.stderr ===================================== @@ -0,0 +1,4 @@ +PatSynArity.hs:6:1: [GHC-18365] + Pattern synonym ‘P’ has two arguments + but its type signature has 1 fewer arrows + In the declaration for pattern synonym ‘P’ ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.hs ===================================== @@ -0,0 +1,6 @@ +{-# language PatternSynonyms #-} + +module PatSynExistential where + +pattern P :: () => forall x. x -> Maybe x +pattern P <- _ ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.stderr ===================================== @@ -0,0 +1,4 @@ +PatSynExistential.hs:6:1: [GHC-33973] + The result type of the signature for ‘P’, namely ‘x -> Maybe x’ + mentions existential type variable ‘x’ + In the declaration for pattern synonym ‘P’ ===================================== testsuite/tests/typecheck/should_fail/PatSynUnboundVar.hs ===================================== @@ -0,0 +1,6 @@ +{-# language PatternSynonyms #-} + +module PatSynUnboundVar where + +pattern P :: Int -> (Int, Int) +pattern P a = (a, b) ===================================== testsuite/tests/typecheck/should_fail/PatSynUnboundVar.stderr ===================================== @@ -0,0 +1,4 @@ +PatSynUnboundVar.hs:6:15: [GHC-28572] + Invalid right-hand side of bidirectional pattern synonym ‘P’: + ‘b’ is not bound by the LHS of the pattern synonym + RHS pattern: (a, b) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -672,3 +672,6 @@ test('T22924a', normal, compile_fail, ['']) test('T22924b', normal, compile_fail, ['']) test('T22940', normal, compile_fail, ['']) test('T19627', normal, compile_fail, ['']) +test('PatSynExistential', normal, compile_fail, ['']) +test('PatSynArity', normal, compile_fail, ['']) +test('PatSynUnboundVar', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/129e7ff13e577c68a5084cbdb9978e1ebebbee0c...cf7678b8bd8207fd405e9bed51fb16d64d2a24ec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/129e7ff13e577c68a5084cbdb9978e1ebebbee0c...cf7678b8bd8207fd405e9bed51fb16d64d2a24ec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 04:15:18 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 24 Mar 2023 00:15:18 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] compiler: Implement atomicSwapIORef with xchg Message-ID: <641d23d67cb08_90da5be74fb810628ba@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: 873cfa51 by Ben Gamari at 2023-03-24T00:15:11-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - 8 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/GHC/IORef.hs - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/include/Cmm.h - rts/include/stg/MiscClosures.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2513,6 +2513,13 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp + MutVar# s v -> v -> State# s -> (# State# s, v #) + {Atomically exchange the value of a 'MutVar#'.} + with + out_of_line = True + has_side_effects = True + -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1559,6 +1559,7 @@ emitPrimOp cfg primop = ResizeMutableByteArrayOp_Char -> alwaysExternal ShrinkSmallMutableArrayOp_Char -> alwaysExternal NewMutVarOp -> alwaysExternal + AtomicSwapMutVarOp -> alwaysExternal AtomicModifyMutVar2Op -> alwaysExternal AtomicModifyMutVar_Op -> alwaysExternal CasMutVarOp -> alwaysExternal ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -859,6 +859,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -127,12 +127,9 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a --- Bad implementation! This will be a primop shortly. atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicModifyMutVar2# ref (\_old -> Box new) s of - (# s', old, Box _new #) -> (# s', old #) - -data Box a = Box a + case atomicSwapMutVar# ref new s of + (# s', old #) -> (# s', old #) -- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both -- the value stored in the 'IORef' and the value returned. The new value ===================================== rts/PrimOps.cmm ===================================== @@ -689,6 +689,17 @@ stg_newMutVarzh ( gcptr init ) return (mv); } +stg_atomicSwapMutVarzh ( gcptr mv, gcptr new ) + /* MutVar# s a -> a -> State# s -> (# State#, a #) */ +{ + W_ old; + (old) = prim %xchgW(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, new); + if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) { + ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr", old "ptr"); + } + return (old); +} + // RRN: To support the "ticketed" approach, we return the NEW rather // than old value if the CAS is successful. This is received in an // opaque form in the Haskell code, preventing the compiler from ===================================== rts/RtsSymbols.c ===================================== @@ -633,6 +633,7 @@ extern char **environ; SymI_HasDataProto(stg_writeIOPortzh) \ SymI_HasDataProto(stg_newIOPortzh) \ SymI_HasDataProto(stg_noDuplicatezh) \ + SymI_HasDataProto(stg_atomicSwapMutVarzh) \ SymI_HasDataProto(stg_atomicModifyMutVar2zh) \ SymI_HasDataProto(stg_atomicModifyMutVarzuzh) \ SymI_HasDataProto(stg_casMutVarzh) \ ===================================== rts/include/Cmm.h ===================================== @@ -193,8 +193,10 @@ #if SIZEOF_W == 4 #define cmpxchgW cmpxchg32 +#define xchgW xchg32 #elif SIZEOF_W == 8 #define cmpxchgW cmpxchg64 +#define xchgW xchg64 #endif /* ----------------------------------------------------------------------------- ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -481,6 +481,7 @@ RTS_FUN_DECL(stg_copySmallMutableArrayzh); RTS_FUN_DECL(stg_casSmallArrayzh); RTS_FUN_DECL(stg_newMutVarzh); +RTS_FUN_DECL(stg_atomicSwapMutVarzh); RTS_FUN_DECL(stg_atomicModifyMutVar2zh); RTS_FUN_DECL(stg_atomicModifyMutVarzuzh); RTS_FUN_DECL(stg_casMutVarzh); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/873cfa51f3b49dfc8c4923456c10c7eb9d3cfef2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/873cfa51f3b49dfc8c4923456c10c7eb9d3cfef2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 04:36:53 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 24 Mar 2023 00:36:53 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 3 commits: testsuite: Add test for atomicSwapIORef Message-ID: <641d28e5d034_90da5c23b2a0106350@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: 6aca8587 by Ben Gamari at 2023-03-24T00:31:02-04:00 testsuite: Add test for atomicSwapIORef - - - - - eca26ff0 by Ben Gamari at 2023-03-24T00:31:02-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - 3343ad87 by Ben Gamari at 2023-03-24T00:36:47-04:00 Make atomicSwapMutVar# an inline primop - - - - - 8 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/GHC/IORef.hs - + libraries/base/tests/AtomicSwapIORef.hs - + libraries/base/tests/AtomicSwapIORef.stdout - libraries/base/tests/all.T - rts/include/Cmm.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2513,6 +2513,12 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp + MutVar# s v -> v -> State# s -> (# State# s, v #) + {Atomically exchange the value of a 'MutVar#'.} + with + has_side_effects = True + -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -297,16 +297,12 @@ emitPrimOp cfg primop = -- MutVar's value. emitPrimCall [] (MO_AtomicWrite (wordWidth platform) MemOrderRelease) [ cmmOffsetW platform mutv (fixedHdrSizeW profile), var ] + emitDirtyMutVar mutv (CmmReg old_val) - platform <- getPlatform - mkdirtyMutVarCCall <- getCode $! emitCCall - [{-no results-}] - (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) - [(baseExpr platform, AddrHint), (mutv, AddrHint), (CmmReg old_val, AddrHint)] - emit =<< mkCmmIfThen - (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel) - (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutv)) - mkdirtyMutVarCCall + AtomicSwapMutVarOp -> \[mutv, val] -> opIntoRegs $ \[res] -> do + let dst = cmmOffsetW platform mutv (fixedHdrSizeW profile) + emitPrimCall [res] (MO_Xchg (wordWidth platform)) [dst, val] + emitDirtyMutVar mutv (CmmReg (CmmLocal res)) -- #define sizzeofByteArrayzh(r,a) \ -- r = ((StgArrBytes *)(a))->bytes @@ -3232,6 +3228,21 @@ doByteArrayBoundsCheck idx arr idx_ty elem_ty = do (elem_sz - 1) doBoundsCheck idx_bytes sz +-- | Write barrier for @MUT_VAR@ modification. +emitDirtyMutVar :: CmmExpr -> CmmExpr -> FCode () +emitDirtyMutVar mutvar old_val = do + cfg <- getStgToCmmConfig + platform <- getPlatform + mkdirtyMutVarCCall <- getCode $! emitCCall + [{-no results-}] + (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) + [(baseExpr platform, AddrHint), (mutvar, AddrHint), (old_val, AddrHint)] + + emit =<< mkCmmIfThen + (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel) + (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutvar)) + mkdirtyMutVarCCall + --------------------------------------------------------------------------- -- Pushing to the update remembered set --------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -859,6 +859,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -127,12 +127,9 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a --- Bad implementation! This will be a primop shortly. atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicModifyMutVar2# ref (\_old -> Box new) s of - (# s', old, Box _new #) -> (# s', old #) - -data Box a = Box a + case atomicSwapMutVar# ref new s of + (# s', old #) -> (# s', old #) -- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both -- the value stored in the 'IORef' and the value returned. The new value ===================================== libraries/base/tests/AtomicSwapIORef.hs ===================================== @@ -0,0 +1,9 @@ +import Data.IORef +import GHC.IORef + +main :: IO () +main = do + r <- newIORef 42 :: IO (IORef Int) + mapM (atomicSwapIORef r) [0..1000] >>= print + mapM (atomicSwapIORef r) [0..10000000] >>= print . sum + readIORef r >>= print ===================================== libraries/base/tests/AtomicSwapIORef.stdout ===================================== @@ -0,0 +1,3 @@ +[42,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299,300,301,302,303,304,305,306,307,308,309,310,311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326,327,328,329,330,331,332,333,334,335,336,337,338,339,340,341,342,343,344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359,360,361,362,363,364,365,366,367,368,369,370,371,372,373,374,375,376,377,378,379,380,381,382,383,384,385,386,387,388,389,390,391,392,393,394,395,396,397,398,399,400,401,402,403,404,405,406,407,408,409,410,411,412,413,414,415,416,417,418,419,420,421,422,423,424,425,426,427,428,429,430,431,432,433,434,435,436,437,438,439,440,441,442,443,444,445,446,447,448,449,450,451,452,453,454,455,456,457,458,459,460,461,462,463,464,465,466,467,468,469,470,471,472,473,474,475,476,477,478,479,480,481,482,483,484,485,486,487,488,489,490,491,492,493,494,495,496,497,498,499,500,501,502,503,504,505,506,507,508,509,510,511,512,513,514,515,516,517,518,519,520,521,522,523,524,525,526,527,528,529,530,531,532,533,534,535,536,537,538,539,540,541,542,543,544,545,546,547,548,549,550,551,552,553,554,555,556,557,558,559,560,561,562,563,564,565,566,567,568,569,570,571,572,573,574,575,576,577,578,579,580,581,582,583,584,585,586,587,588,589,590,591,592,593,594,595,596,597,598,599,600,601,602,603,604,605,606,607,608,609,610,611,612,613,614,615,616,617,618,619,620,621,622,623,624,625,626,627,628,629,630,631,632,633,634,635,636,637,638,639,640,641,642,643,644,645,646,647,648,649,650,651,652,653,654,655,656,657,658,659,660,661,662,663,664,665,666,667,668,669,670,671,672,673,674,675,676,677,678,679,680,681,682,683,684,685,686,687,688,689,690,691,692,693,694,695,696,697,698,699,700,701,702,703,704,705,706,707,708,709,710,711,712,713,714,715,716,717,718,719,720,721,722,723,724,725,726,727,728,729,730,731,732,733,734,735,736,737,738,739,740,741,742,743,744,745,746,747,748,749,750,751,752,753,754,755,756,757,758,759,760,761,762,763,764,765,766,767,768,769,770,771,772,773,774,775,776,777,778,779,780,781,782,783,784,785,786,787,788,789,790,791,792,793,794,795,796,797,798,799,800,801,802,803,804,805,806,807,808,809,810,811,812,813,814,815,816,817,818,819,820,821,822,823,824,825,826,827,828,829,830,831,832,833,834,835,836,837,838,839,840,841,842,843,844,845,846,847,848,849,850,851,852,853,854,855,856,857,858,859,860,861,862,863,864,865,866,867,868,869,870,871,872,873,874,875,876,877,878,879,880,881,882,883,884,885,886,887,888,889,890,891,892,893,894,895,896,897,898,899,900,901,902,903,904,905,906,907,908,909,910,911,912,913,914,915,916,917,918,919,920,921,922,923,924,925,926,927,928,929,930,931,932,933,934,935,936,937,938,939,940,941,942,943,944,945,946,947,948,949,950,951,952,953,954,955,956,957,958,959,960,961,962,963,964,965,966,967,968,969,970,971,972,973,974,975,976,977,978,979,980,981,982,983,984,985,986,987,988,989,990,991,992,993,994,995,996,997,998,999] +49999995001000 +10000000 ===================================== libraries/base/tests/all.T ===================================== @@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('AtomicSwapIORef', normal, compile_and_run, ['']) ===================================== rts/include/Cmm.h ===================================== @@ -193,8 +193,10 @@ #if SIZEOF_W == 4 #define cmpxchgW cmpxchg32 +#define xchgW xchg32 #elif SIZEOF_W == 8 #define cmpxchgW cmpxchg64 +#define xchgW xchg64 #endif /* ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/873cfa51f3b49dfc8c4923456c10c7eb9d3cfef2...3343ad87b92cff627aeb7d55af4c1a7006f42b37 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/873cfa51f3b49dfc8c4923456c10c7eb9d3cfef2...3343ad87b92cff627aeb7d55af4c1a7006f42b37 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 06:36:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 24 Mar 2023 02:36:27 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Allow WARNING pragmas to be controlled with custom categories Message-ID: <641d44ebe5d73_90da5e27bdf810790e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - 30 changed files: - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/using-warnings.rst - testsuite/tests/parser/should_compile/T3303.stderr - testsuite/tests/rename/should_compile/T5867.stderr - testsuite/tests/rename/should_compile/rn050.stderr - testsuite/tests/rename/should_compile/rn066.stderr - testsuite/tests/rename/should_fail/T5281.stderr - testsuite/tests/warnings/should_compile/DeprU.stderr - + testsuite/tests/warnings/should_fail/WarningCategory1.hs - + testsuite/tests/warnings/should_fail/WarningCategory1.stderr - + testsuite/tests/warnings/should_fail/WarningCategory1_B.hs - + testsuite/tests/warnings/should_fail/WarningCategory2.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e1c8c41d62854553d889403d8ee52d120c26bc66...0426515be8836acfdde7ddc9cf35a99a7a73f278 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e1c8c41d62854553d889403d8ee52d120c26bc66...0426515be8836acfdde7ddc9cf35a99a7a73f278 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 06:37:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 24 Mar 2023 02:37:02 -0400 Subject: [Git][ghc/ghc][master] nativeGen/AArch64: Fix bitmask immediate predicate Message-ID: <641d450e99760_90da5e1f2d28108448b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -773,12 +773,12 @@ getRegister' config plat expr return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) -- 3. Logic &&, || - CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isBitMaskImmediate (fromIntegral n) -> + CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (fromIntegral n) -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (AND (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) where w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) r' = getRegisterReg plat reg - CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isBitMaskImmediate (fromIntegral n) -> + CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isAArch64Bitmask (fromIntegral n) -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ORR (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) where w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) r' = getRegisterReg plat reg @@ -963,19 +963,6 @@ getRegister' config plat expr where isNbitEncodeable :: Int -> Integer -> Bool isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) - -- This needs to check if n can be encoded as a bitmask immediate: - -- - -- See https://stackoverflow.com/questions/30904718/range-of-immediate-values-in-armv8-a64-assembly - -- - isBitMaskImmediate :: Integer -> Bool - isBitMaskImmediate i = i `elem` [0b0000_0001, 0b0000_0010, 0b0000_0100, 0b0000_1000, 0b0001_0000, 0b0010_0000, 0b0100_0000, 0b1000_0000 - ,0b0000_0011, 0b0000_0110, 0b0000_1100, 0b0001_1000, 0b0011_0000, 0b0110_0000, 0b1100_0000 - ,0b0000_0111, 0b0000_1110, 0b0001_1100, 0b0011_1000, 0b0111_0000, 0b1110_0000 - ,0b0000_1111, 0b0001_1110, 0b0011_1100, 0b0111_1000, 0b1111_0000 - ,0b0001_1111, 0b0011_1110, 0b0111_1100, 0b1111_1000 - ,0b0011_1111, 0b0111_1110, 0b1111_1100 - ,0b0111_1111, 0b1111_1110 - ,0b1111_1111] -- N.B. MUL does not set the overflow flag. do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register @@ -1018,6 +1005,39 @@ getRegister' config plat expr CMP (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) `snocOL` CSET (OpReg w dst) NE) +-- | Is a given number encodable as a bitmask immediate? +-- +-- https://stackoverflow.com/questions/30904718/range-of-immediate-values-in-armv8-a64-assembly +isAArch64Bitmask :: Integer -> Bool +-- N.B. zero and ~0 are not encodable as bitmask immediates +isAArch64Bitmask 0 = False +isAArch64Bitmask n + | n == bit 64 - 1 = False +isAArch64Bitmask n = + check 64 || check 32 || check 16 || check 8 + where + -- Check whether @n@ can be represented as a subpattern of the given + -- width. + check width + | hasOneRun subpat = + let n' = fromIntegral (mkPat width subpat) + in n == n' + | otherwise = False + where + subpat :: Word64 + subpat = fromIntegral (n .&. (bit width - 1)) + + -- Construct a bit-pattern from a repeated subpatterns the given width. + mkPat :: Int -> Word64 -> Word64 + mkPat width subpat = + foldl' (.|.) 0 [ subpat `shiftL` p | p <- [0, width..63] ] + + -- Does the given number's bit representation match the regular expression + -- @0*1*0*@? + hasOneRun :: Word64 -> Bool + hasOneRun m = + 64 == popCount m + countLeadingZeros m + countTrailingZeros m + -- | Instructions to sign-extend the value in the given register from width @w@ -- up to width @w'@. signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8d783d24b9a617ad1e3038abeb75d322703ef65 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8d783d24b9a617ad1e3038abeb75d322703ef65 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 07:55:25 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Fri, 24 Mar 2023 03:55:25 -0400 Subject: [Git][ghc/ghc][wip/amg/T22757] 9 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <641d576d5f554_90da5fc1890010977e4@gitlab.mail> Adam Gundry pushed to branch wip/amg/T22757 at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - e85b22e1 by Adam Gundry at 2023-03-24T07:54:58+00:00 Add `-Wunclassified` warning flag so all warnings have flags (#22757) In particular this means that warnings without flags, such as those generated by `reportWarning` in Template Haskell, can still be suppresed using `-w`. - - - - - 30 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/using-warnings.rst - libraries/base/Data/Functor/Compose.hs - libraries/base/changelog.md - testsuite/tests/corelint/LintEtaExpand.stderr - testsuite/tests/corelint/T21115b.stderr - testsuite/tests/deSugar/should_compile/T13290.stderr - testsuite/tests/dependent/should_compile/T14066a.stderr - testsuite/tests/driver/T20436/T20436.stderr - testsuite/tests/ghc-api/T10052/T10052.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c2f4d42820c2d9ca543e00ab21d9ee69f6ff162...e85b22e1a14dba3bc02518db40e4b557d11c5d66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c2f4d42820c2d9ca543e00ab21d9ee69f6ff162...e85b22e1a14dba3bc02518db40e4b557d11c5d66 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 11:33:53 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 24 Mar 2023 07:33:53 -0400 Subject: [Git][ghc/ghc][wip/clc-148] 9 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <641d8aa19c84c_90da6362d46011517a8@gitlab.mail> Ryan Scott pushed to branch wip/clc-148 at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - c5a28889 by Ryan Scott at 2023-03-24T07:33:37-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 30 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/using-warnings.rst - libraries/base/Data/Functor/Compose.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/changelog.md - testsuite/tests/parser/should_compile/T3303.stderr - testsuite/tests/patsyn/should_fail/T14112.stderr - testsuite/tests/patsyn/should_fail/T14507.stderr - testsuite/tests/patsyn/should_fail/unidir.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d0e77e157ec88d300cef1f4b43c650fc0125f2be...c5a28889a0a20a72c38e8e3f4bbbe75854d8390f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d0e77e157ec88d300cef1f4b43c650fc0125f2be...c5a28889a0a20a72c38e8e3f4bbbe75854d8390f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 11:39:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 24 Mar 2023 07:39:38 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Allow WARNING pragmas to be controlled with custom categories Message-ID: <641d8bfabde1d_90da636b7afc1152057@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - bbc90826 by Joachim Breitner at 2023-03-24T07:39:34-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 14d989e8 by Ben Gamari at 2023-03-24T07:39:34-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 30 changed files: - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/using-warnings.rst - testsuite/tests/parser/should_compile/T3303.stderr - testsuite/tests/rename/should_compile/T5867.stderr - testsuite/tests/rename/should_compile/rn050.stderr - testsuite/tests/rename/should_compile/rn066.stderr - testsuite/tests/rename/should_fail/T5281.stderr - testsuite/tests/warnings/should_compile/DeprU.stderr - + testsuite/tests/warnings/should_fail/WarningCategory1.hs - + testsuite/tests/warnings/should_fail/WarningCategory1.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a389a6c91ccdeba47781149373f6c826a818068d...14d989e89d71a2d9bd02a6ca753a0ec80115a789 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a389a6c91ccdeba47781149373f6c826a818068d...14d989e89d71a2d9bd02a6ca753a0ec80115a789 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 12:24:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 24 Mar 2023 08:24:33 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 3 commits: testsuite: Add test for atomicSwapIORef Message-ID: <641d96817f4d3_90da64483af0116087f@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: b7133810 by Ben Gamari at 2023-03-24T08:24:27-04:00 testsuite: Add test for atomicSwapIORef - - - - - 60f62c15 by Ben Gamari at 2023-03-24T08:24:27-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - 153b20cb by Ben Gamari at 2023-03-24T08:24:27-04:00 Make atomicSwapMutVar# an inline primop - - - - - 8 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/GHC/IORef.hs - + libraries/base/tests/AtomicSwapIORef.hs - + libraries/base/tests/AtomicSwapIORef.stdout - libraries/base/tests/all.T - rts/include/Cmm.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2513,6 +2513,12 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp + MutVar# s v -> v -> State# s -> (# State# s, v #) + {Atomically exchange the value of a 'MutVar#'.} + with + has_side_effects = True + -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -297,16 +297,12 @@ emitPrimOp cfg primop = -- MutVar's value. emitPrimCall [] (MO_AtomicWrite (wordWidth platform) MemOrderRelease) [ cmmOffsetW platform mutv (fixedHdrSizeW profile), var ] + emitDirtyMutVar mutv (CmmReg old_val) - platform <- getPlatform - mkdirtyMutVarCCall <- getCode $! emitCCall - [{-no results-}] - (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) - [(baseExpr platform, AddrHint), (mutv, AddrHint), (CmmReg old_val, AddrHint)] - emit =<< mkCmmIfThen - (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel) - (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutv)) - mkdirtyMutVarCCall + AtomicSwapMutVarOp -> \[mutv, val] -> opIntoRegs $ \[res] -> do + let dst = cmmOffsetW platform mutv (fixedHdrSizeW profile) + emitPrimCall [res] (MO_Xchg (wordWidth platform)) [dst, val] + emitDirtyMutVar mutv (CmmReg (CmmLocal res)) -- #define sizzeofByteArrayzh(r,a) \ -- r = ((StgArrBytes *)(a))->bytes @@ -3232,6 +3228,21 @@ doByteArrayBoundsCheck idx arr idx_ty elem_ty = do (elem_sz - 1) doBoundsCheck idx_bytes sz +-- | Write barrier for @MUT_VAR@ modification. +emitDirtyMutVar :: CmmExpr -> CmmExpr -> FCode () +emitDirtyMutVar mutvar old_val = do + cfg <- getStgToCmmConfig + platform <- getPlatform + mkdirtyMutVarCCall <- getCode $! emitCCall + [{-no results-}] + (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) + [(baseExpr platform, AddrHint), (mutvar, AddrHint), (old_val, AddrHint)] + + emit =<< mkCmmIfThen + (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel) + (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutvar)) + mkdirtyMutVarCCall + --------------------------------------------------------------------------- -- Pushing to the update remembered set --------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -859,6 +859,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -127,12 +127,9 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a --- Bad implementation! This will be a primop shortly. atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicModifyMutVar2# ref (\_old -> Box new) s of - (# s', old, Box _new #) -> (# s', old #) - -data Box a = Box a + case atomicSwapMutVar# ref new s of + (# s', old #) -> (# s', old #) -- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both -- the value stored in the 'IORef' and the value returned. The new value ===================================== libraries/base/tests/AtomicSwapIORef.hs ===================================== @@ -0,0 +1,10 @@ +import Data.IORef +import GHC.IORef +import Data.Word + +main :: IO () +main = do + r <- newIORef 42 :: IO (IORef Int) + mapM (atomicSwapIORef r) [0..1000] >>= print + mapM (atomicSwapIORef r) [0..1000000] >>= print . sum + readIORef r >>= print ===================================== libraries/base/tests/AtomicSwapIORef.stdout ===================================== @@ -0,0 +1,3 @@ +[42,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299,300,301,302,303,304,305,306,307,308,309,310,311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326,327,328,329,330,331,332,333,334,335,336,337,338,339,340,341,342,343,344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359,360,361,362,363,364,365,366,367,368,369,370,371,372,373,374,375,376,377,378,379,380,381,382,383,384,385,386,387,388,389,390,391,392,393,394,395,396,397,398,399,400,401,402,403,404,405,406,407,408,409,410,411,412,413,414,415,416,417,418,419,420,421,422,423,424,425,426,427,428,429,430,431,432,433,434,435,436,437,438,439,440,441,442,443,444,445,446,447,448,449,450,451,452,453,454,455,456,457,458,459,460,461,462,463,464,465,466,467,468,469,470,471,472,473,474,475,476,477,478,479,480,481,482,483,484,485,486,487,488,489,490,491,492,493,494,495,496,497,498,499,500,501,502,503,504,505,506,507,508,509,510,511,512,513,514,515,516,517,518,519,520,521,522,523,524,525,526,527,528,529,530,531,532,533,534,535,536,537,538,539,540,541,542,543,544,545,546,547,548,549,550,551,552,553,554,555,556,557,558,559,560,561,562,563,564,565,566,567,568,569,570,571,572,573,574,575,576,577,578,579,580,581,582,583,584,585,586,587,588,589,590,591,592,593,594,595,596,597,598,599,600,601,602,603,604,605,606,607,608,609,610,611,612,613,614,615,616,617,618,619,620,621,622,623,624,625,626,627,628,629,630,631,632,633,634,635,636,637,638,639,640,641,642,643,644,645,646,647,648,649,650,651,652,653,654,655,656,657,658,659,660,661,662,663,664,665,666,667,668,669,670,671,672,673,674,675,676,677,678,679,680,681,682,683,684,685,686,687,688,689,690,691,692,693,694,695,696,697,698,699,700,701,702,703,704,705,706,707,708,709,710,711,712,713,714,715,716,717,718,719,720,721,722,723,724,725,726,727,728,729,730,731,732,733,734,735,736,737,738,739,740,741,742,743,744,745,746,747,748,749,750,751,752,753,754,755,756,757,758,759,760,761,762,763,764,765,766,767,768,769,770,771,772,773,774,775,776,777,778,779,780,781,782,783,784,785,786,787,788,789,790,791,792,793,794,795,796,797,798,799,800,801,802,803,804,805,806,807,808,809,810,811,812,813,814,815,816,817,818,819,820,821,822,823,824,825,826,827,828,829,830,831,832,833,834,835,836,837,838,839,840,841,842,843,844,845,846,847,848,849,850,851,852,853,854,855,856,857,858,859,860,861,862,863,864,865,866,867,868,869,870,871,872,873,874,875,876,877,878,879,880,881,882,883,884,885,886,887,888,889,890,891,892,893,894,895,896,897,898,899,900,901,902,903,904,905,906,907,908,909,910,911,912,913,914,915,916,917,918,919,920,921,922,923,924,925,926,927,928,929,930,931,932,933,934,935,936,937,938,939,940,941,942,943,944,945,946,947,948,949,950,951,952,953,954,955,956,957,958,959,960,961,962,963,964,965,966,967,968,969,970,971,972,973,974,975,976,977,978,979,980,981,982,983,984,985,986,987,988,989,990,991,992,993,994,995,996,997,998,999] +499999501000 +1000000 ===================================== libraries/base/tests/all.T ===================================== @@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('AtomicSwapIORef', normal, compile_and_run, ['']) ===================================== rts/include/Cmm.h ===================================== @@ -193,8 +193,10 @@ #if SIZEOF_W == 4 #define cmpxchgW cmpxchg32 +#define xchgW xchg32 #elif SIZEOF_W == 8 #define cmpxchgW cmpxchg64 +#define xchgW xchg64 #endif /* ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3343ad87b92cff627aeb7d55af4c1a7006f42b37...153b20cb8eed326c965c6963b93a11d1ab4fe38f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3343ad87b92cff627aeb7d55af4c1a7006f42b37...153b20cb8eed326c965c6963b93a11d1ab4fe38f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 12:28:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 24 Mar 2023 08:28:16 -0400 Subject: [Git][ghc/ghc][wip/T23170] nonmoving: Disable slop-zeroing Message-ID: <641d97606aa9e_90da6476eb0c11618a5@gitlab.mail> Ben Gamari pushed to branch wip/T23170 at Glasgow Haskell Compiler / GHC Commits: a3c8bb7a by Ben Gamari at 2023-03-24T08:28:09-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 1 changed file: - rts/include/rts/storage/ClosureMacros.h Changes: ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -479,11 +479,13 @@ EXTERN_INLINE StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n) memory we're about to zero. Thus, with the THREADED RTS and +RTS -N2 or greater we must not zero - immutable closure's slop. + immutable closure's slop. Similarly, the concurrent GC's mark thread + may race when a mutator during slop-zeroing. Consequently, we also disable + zeroing when the non-moving GC is in use. Hence, an immutable closure's slop is zeroed when either: - - PROFILING && era > 0 (LDV is on) or + - PROFILING && era > 0 (LDV is on) && !nonmoving-gc-enabled or - !THREADED && DEBUG Additionally: @@ -541,7 +543,8 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) const bool can_zero_immutable_slop = // Only if we're running single threaded. - RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1; + RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1 + && !RTS_DEREF(RtsFlags).GcFlags.useNonmoving; // see #23170 const bool zero_slop_immutable = want_to_zero_immutable_slop && can_zero_immutable_slop; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3c8bb7a904660ab97f3d09c38077d89be472301 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3c8bb7a904660ab97f3d09c38077d89be472301 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 12:29:49 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 24 Mar 2023 08:29:49 -0400 Subject: [Git][ghc/ghc][wip/T22706] base: Export GHC.Conc.Sync.fromThreadId Message-ID: <641d97bdbb6ea_90da647f6354116221b@gitlab.mail> Ben Gamari pushed to branch wip/T22706 at Glasgow Haskell Compiler / GHC Commits: b9c348b9 by Ben Gamari at 2023-03-24T08:29:42-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 2 changed files: - libraries/base/GHC/Conc/Sync.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -33,6 +33,7 @@ module GHC.Conc.Sync ( -- * Threads ThreadId(..) + , fromThreadId , showThreadId , myThreadId , killThread @@ -152,11 +153,18 @@ This misfeature will hopefully be corrected at a later date. -} +-- | Map a thread to an integer identifier which is unique within the +-- current process. +-- +-- @since 4.19.0.0 +fromThreadId :: ThreadId -> Word64 +fromThreadId = fromIntegral . getThreadId . id2TSO + -- | @since 4.2.0.0 instance Show ThreadId where showsPrec d t = showParen (d >= 11) $ showString "ThreadId " . - showsPrec d (getThreadId (id2TSO t)) + showsPrec d (fromThreadId t) showThreadId :: ThreadId -> String showThreadId = show ===================================== libraries/base/changelog.md ===================================== @@ -1,6 +1,8 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) ## 4.19.0.0 *TBA* + + * `GHC.Conc.Sync` now exports `fromThreadId :: ThreadId -> Word64`, which maps a thread to a per-process-unique identifier ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) * Add `Data.List.!?` ([CLC proposal #110](https://github.com/haskell/core-libraries-committee/issues/110)) * `maximumBy`/`minimumBy` are now marked as `INLINE` improving performance for unpackable types significantly. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9c348b964b4f26180a1a6262db71cc06af00801 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9c348b964b4f26180a1a6262db71cc06af00801 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 13:56:35 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 24 Mar 2023 09:56:35 -0400 Subject: [Git][ghc/ghc][wip/rts-warnings] 4 commits: nonmoving: Fix unused definition warrnings Message-ID: <641dac134d20a_13561a975b941935b@gitlab.mail> Ben Gamari pushed to branch wip/rts-warnings at Glasgow Haskell Compiler / GHC Commits: 5d68cd30 by Ben Gamari at 2023-03-24T09:56:27-04:00 nonmoving: Fix unused definition warrnings - - - - - 8eb02189 by Ben Gamari at 2023-03-24T09:56:27-04:00 Disable futimens on Darwin. See #22938 - - - - - 1a40ca00 by Ben Gamari at 2023-03-24T09:56:27-04:00 rts: Fix incorrect CPP guard - - - - - 318ea2e4 by Ben Gamari at 2023-03-24T09:56:27-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - hadrian/src/Flavour.hs - rts/posix/Ticker.c - rts/sm/NonMovingMark.c Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -397,6 +397,8 @@ opsysVariables Amd64 (Darwin {}) = , "ac_cv_func_clock_gettime" =: "no" -- # Only newer OS Xs support utimensat. See #17895 , "ac_cv_func_utimensat" =: "no" + -- # Only newer OS Xs support futimens. See #22938 + , "ac_cv_func_futimens" =: "no" , "LANG" =: "en_US.UTF-8" , "CONFIGURE_ARGS" =: "--with-intree-gmp --with-system-libffi" -- Fonts can't be installed on darwin ===================================== .gitlab/jobs.yaml ===================================== @@ -480,6 +480,7 @@ "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", + "ac_cv_func_futimens": "no", "ac_cv_func_utimensat": "no" } }, @@ -2416,6 +2417,7 @@ "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", + "ac_cv_func_futimens": "no", "ac_cv_func_utimensat": "no" } }, @@ -3458,6 +3460,7 @@ "NIX_SYSTEM": "x86_64-darwin", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", + "ac_cv_func_futimens": "no", "ac_cv_func_utimensat": "no" } }, ===================================== hadrian/src/Flavour.hs ===================================== @@ -123,16 +123,25 @@ addArgs args' fl = fl { args = args fl <> args' } -- from warnings. werror :: Flavour -> Flavour werror = - addArgs - ( builder Ghc + addArgs $ mconcat + [ builder Ghc ? notStage0 ? mconcat - [ arg "-Werror", - flag CrossCompiling + [ arg "-Werror" + , flag CrossCompiling ? package unix ? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"] ] - ) + , builder Ghc + ? package rts + ? mconcat + [ arg "-optc-Werror" + -- clang complains about #pragma GCC pragmas + , arg "-optc-Wno-error=unknown-pragmas" + ] + -- N.B. We currently don't build the boot libraries' C sources with -Werror + -- as this tends to be a portability nightmare. + ] -- | Build C and Haskell objects with debugging information. enableDebugInfo :: Flavour -> Flavour ===================================== rts/posix/Ticker.c ===================================== @@ -71,7 +71,7 @@ * For older version of linux/netbsd without timerfd we fall back to the * pthread based implementation. */ -#if HAVE_SYS_TIMERFD_H +#if defined(HAVE_SYS_TIMERFD_H) #define USE_TIMERFD_FOR_ITIMER #endif ===================================== rts/sm/NonMovingMark.c ===================================== @@ -39,7 +39,9 @@ static void trace_PAP_payload (MarkQueue *queue, StgClosure *fun, StgClosure **payload, StgWord size); +#if defined(DEBUG) static bool is_nonmoving_weak(StgWeak *weak); +#endif // How many Array# entries to add to the mark queue at once? #define MARK_ARRAY_CHUNK_LENGTH 128 @@ -967,7 +969,7 @@ static void nonmovingResetUpdRemSetQueue (MarkQueue *rset) rset->top->head = 0; } -void nonmovingResetUpdRemSet (UpdRemSet *rset) +static void nonmovingResetUpdRemSet (UpdRemSet *rset) { nonmovingResetUpdRemSetQueue(&rset->queue); } @@ -1966,6 +1968,7 @@ void nonmovingMarkWeakPtrList (struct MarkQueue_ *queue) // Determine whether a weak pointer object is on one of the nonmoving // collector's weak pointer lists. Used for sanity checking. +#if defined(DEBUG) static bool is_nonmoving_weak(StgWeak *weak) { for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = w->link) { @@ -1976,6 +1979,7 @@ static bool is_nonmoving_weak(StgWeak *weak) } return false; } +#endif // Non-moving heap variant of `tidyWeakList` bool nonmovingTidyWeaks (struct MarkQueue_ *queue) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b04679afb1418620cf0ff059eca6fdf16b7f7d3...318ea2e411fef8bd2674e74b0ff1454c14713fd4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b04679afb1418620cf0ff059eca6fdf16b7f7d3...318ea2e411fef8bd2674e74b0ff1454c14713fd4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 14:12:29 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 24 Mar 2023 10:12:29 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/rep-arity Message-ID: <641dafcdbbdaa_13561af6fb3027117@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/rep-arity at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/rep-arity You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 16:36:51 2023 From: gitlab at gitlab.haskell.org (Adam Gundry (@adamgundry)) Date: Fri, 24 Mar 2023 12:36:51 -0400 Subject: [Git][ghc/ghc][wip/amg/T22757] Add `-Wunclassified` warning flag so all warnings have flags (#22757) Message-ID: <641dd1a31aa1f_13561a33eb0f4504bc@gitlab.mail> Adam Gundry pushed to branch wip/amg/T22757 at Glasgow Haskell Compiler / GHC Commits: a2f4dbfd by Adam Gundry at 2023-03-24T16:36:43+00:00 Add `-Wunclassified` warning flag so all warnings have flags (#22757) In particular this means that warnings without flags, such as those generated by `reportWarning` in Template Haskell, can still be suppresed using `-w`. - - - - - 30 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/using-warnings.rst - testsuite/tests/corelint/LintEtaExpand.stderr - testsuite/tests/corelint/T21115b.stderr - testsuite/tests/deSugar/should_compile/T13290.stderr - testsuite/tests/dependent/should_compile/T14066a.stderr - testsuite/tests/driver/T20436/T20436.stderr - testsuite/tests/ghc-api/T10052/T10052.stderr - testsuite/tests/ghci.debugger/scripts/print007.stderr - testsuite/tests/ghci/scripts/StaticPtr.stderr - testsuite/tests/ghci/should_fail/T10549.stderr - testsuite/tests/ghci/should_fail/T10549a.stderr - testsuite/tests/indexed-types/should_compile/T9085.stderr - testsuite/tests/parser/should_compile/OpaqueParseWarn1.stderr - testsuite/tests/plugins/T19926.stderr - testsuite/tests/pmcheck/should_compile/TooManyDeltas.stderr - testsuite/tests/rename/should_compile/rn049.stderr - testsuite/tests/safeHaskell/check/Check05.stderr - testsuite/tests/safeHaskell/flags/SafeFlags18.stderr - testsuite/tests/safeHaskell/ghci/p1.stderr - testsuite/tests/safeHaskell/ghci/p14.stderr - testsuite/tests/safeHaskell/ghci/p16.stderr - testsuite/tests/safeHaskell/overlapping/SH_Overlap11.stderr - testsuite/tests/safeHaskell/overlapping/SH_Overlap7.stderr - testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr - testsuite/tests/safeHaskell/safeInfered/UnsafeWarn05.stderr - testsuite/tests/safeHaskell/safeInfered/UnsafeWarn06.stderr - testsuite/tests/safeHaskell/safeInfered/UnsafeWarn07.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2f4dbfd57ec8dc52db9b41761d3b958f6a143d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2f4dbfd57ec8dc52db9b41761d3b958f6a143d5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 17:09:59 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 24 Mar 2023 13:09:59 -0400 Subject: [Git][ghc/ghc][master] User's guide: Improve docs for -Wall Message-ID: <641dd96710873_13561a3d9b2985703@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 1 changed file: - docs/users_guide/using-warnings.rst Changes: ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -113,32 +113,24 @@ as ``-Wno-...`` for every individual warning in the group. :category: Turns on all warning options that indicate potentially suspicious - code. The warnings that are *not* enabled by :ghc-flag:`-Wall` are + code. They include all warnings in :ghc-flag:`-Wextra`, plus: .. hlist:: :columns: 3 - * :ghc-flag:`-Wmonomorphism-restriction` - * :ghc-flag:`-Wimplicit-prelude` - * :ghc-flag:`-Wmissing-local-signatures` - * :ghc-flag:`-Wmissing-exported-signatures` - * :ghc-flag:`-Wmissing-export-lists` - * :ghc-flag:`-Wmissing-import-lists` - * :ghc-flag:`-Wmissing-home-modules` - * :ghc-flag:`-Widentities` - * :ghc-flag:`-Wredundant-constraints` - * :ghc-flag:`-Wpartial-fields` - * :ghc-flag:`-Wmissed-specialisations` - * :ghc-flag:`-Wall-missed-specialisations` - * :ghc-flag:`-Wcpp-undef` - * :ghc-flag:`-Wduplicate-constraints` - * :ghc-flag:`-Wmissing-deriving-strategies` - * :ghc-flag:`-Wunused-packages` - * :ghc-flag:`-Wunused-type-patterns` - * :ghc-flag:`-Wsafe` - * :ghc-flag:`-Wimplicit-lift` - * :ghc-flag:`-Wmissing-kind-signatures` - * :ghc-flag:`-Wunticked-promoted-constructors` + * :ghc-flag:`-Whi-shadowing` + * :ghc-flag:`-Wincomplete-record-updates` + * :ghc-flag:`-Wincomplete-uni-patterns` + * :ghc-flag:`-Wmissing-pattern-synonym-signatures` + * :ghc-flag:`-Wmissing-signatures` + * :ghc-flag:`-Wname-shadowing` + * :ghc-flag:`-Worphans` + * :ghc-flag:`-Wredundant-record-wildcards` + * :ghc-flag:`-Wstar-is-type` + * :ghc-flag:`-Wtrustworthy-safe` + * :ghc-flag:`-Wtype-defaults` + * :ghc-flag:`-Wunused-do-bind` + * :ghc-flag:`-Wunused-record-wildcards` .. ghc-flag:: -Weverything :shortdesc: enable all warnings supported by GHC View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/46120bb637452be6e16e5dd7091c0b469a5adcd5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/46120bb637452be6e16e5dd7091c0b469a5adcd5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 17:10:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 24 Mar 2023 13:10:39 -0400 Subject: [Git][ghc/ghc][master] codeGen/tsan: Disable instrumentation of unaligned stores Message-ID: <641dd98fedb99_13561a3e8d50c621dc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 1 changed file: - compiler/GHC/Cmm/ThreadSanitizer.hs Changes: ===================================== compiler/GHC/Cmm/ThreadSanitizer.hs ===================================== @@ -54,11 +54,13 @@ annotateNode env node = CmmTick{} -> BMiddle node CmmUnwind{} -> BMiddle node CmmAssign{} -> annotateNodeOO env node - CmmStore lhs rhs align -> + -- TODO: Track unaligned stores + CmmStore _ _ Unaligned -> annotateNodeOO env node + CmmStore lhs rhs NaturallyAligned -> let ty = cmmExprType (platform env) rhs rhs_nodes = annotateLoads env (collectExprLoads rhs) lhs_nodes = annotateLoads env (collectExprLoads lhs) - st = tsanStore env align ty lhs + st = tsanStore env ty lhs in rhs_nodes `blockAppend` lhs_nodes `blockAppend` st `blockSnoc` node CmmUnsafeForeignCall (PrimTarget op) formals args -> let node' = fromMaybe (BMiddle node) (annotatePrim env op formals args) @@ -197,17 +199,14 @@ tsanTarget fn formals args = lbl = mkForeignLabel fn Nothing ForeignLabelInExternalPackage IsFunction tsanStore :: Env - -> AlignmentSpec -> CmmType -> CmmExpr + -> CmmType -> CmmExpr -> Block CmmNode O O -tsanStore env align ty addr = +tsanStore env ty addr = mkUnsafeCall env ftarget [] [addr] where ftarget = tsanTarget fn [] [AddrHint] w = widthInBytes (typeWidth ty) - fn = case align of - Unaligned - | w > 1 -> fsLit $ "__tsan_unaligned_write" ++ show w - _ -> fsLit $ "__tsan_write" ++ show w + fn = fsLit $ "__tsan_write" ++ show w tsanLoad :: Env -> AlignmentSpec -> CmmType -> CmmExpr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/509d1f11bf4e7eb4b916ae1c33abc48047b3be0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/509d1f11bf4e7eb4b916ae1c33abc48047b3be0e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 17:42:12 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 24 Mar 2023 13:42:12 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: User's guide: Improve docs for -Wall Message-ID: <641de0f42152b_13561a4b1ece463787@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 61e9cd7e by Li-yao Xia at 2023-03-24T13:41:38-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 857e5355 by Teo Camarasu at 2023-03-24T13:41:43-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - bdbaf88a by Teo Camarasu at 2023-03-24T13:41:43-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7aaf8ade by David Feuer at 2023-03-24T13:41:48-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - 99147c37 by Ben Gamari at 2023-03-24T13:41:48-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - ab554601 by Krzysztof Gogolewski at 2023-03-24T13:41:49-04:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - 08285a6a by sheaf at 2023-03-24T13:41:49-04:00 Handle ConcreteTvs in inferResultToType This patch fixes two issues. 1. inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. 2. startSolvingByUnification can make some type variables concrete. However, it didn't return an updated type, so callers of this function, if they don't zonk, might miss this and accidentally perform a double update of a metavariable. We now return the updated type from this function, which avoids this issue. Fixes #23154 - - - - - 30 changed files: - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Utils/Zonk.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/using-warnings.rst - libraries/base/GHC/Conc/Sync.hs - libraries/base/changelog.md - rts/StgMiscClosures.cmm - rts/include/stg/SMP.h - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/Storage.c - testsuite/tests/rep-poly/RepPolyPatBind.stderr - + testsuite/tests/rep-poly/T23153.hs - + testsuite/tests/rep-poly/T23153.stderr - + testsuite/tests/rep-poly/T23154.hs - + testsuite/tests/rep-poly/T23154.stderr - testsuite/tests/rep-poly/all.T - + testsuite/tests/rts/T17574.hs - + testsuite/tests/rts/T17574.stdout - testsuite/tests/rts/all.T - testsuite/tests/typecheck/should_fail/VtaFail.stderr Changes: ===================================== compiler/GHC/Cmm/ThreadSanitizer.hs ===================================== @@ -54,11 +54,13 @@ annotateNode env node = CmmTick{} -> BMiddle node CmmUnwind{} -> BMiddle node CmmAssign{} -> annotateNodeOO env node - CmmStore lhs rhs align -> + -- TODO: Track unaligned stores + CmmStore _ _ Unaligned -> annotateNodeOO env node + CmmStore lhs rhs NaturallyAligned -> let ty = cmmExprType (platform env) rhs rhs_nodes = annotateLoads env (collectExprLoads rhs) lhs_nodes = annotateLoads env (collectExprLoads lhs) - st = tsanStore env align ty lhs + st = tsanStore env ty lhs in rhs_nodes `blockAppend` lhs_nodes `blockAppend` st `blockSnoc` node CmmUnsafeForeignCall (PrimTarget op) formals args -> let node' = fromMaybe (BMiddle node) (annotatePrim env op formals args) @@ -197,17 +199,14 @@ tsanTarget fn formals args = lbl = mkForeignLabel fn Nothing ForeignLabelInExternalPackage IsFunction tsanStore :: Env - -> AlignmentSpec -> CmmType -> CmmExpr + -> CmmType -> CmmExpr -> Block CmmNode O O -tsanStore env align ty addr = +tsanStore env ty addr = mkUnsafeCall env ftarget [] [addr] where ftarget = tsanTarget fn [] [AddrHint] w = widthInBytes (typeWidth ty) - fn = case align of - Unaligned - | w > 1 -> fsLit $ "__tsan_unaligned_write" ++ show w - _ -> fsLit $ "__tsan_write" ++ show w + fn = fsLit $ "__tsan_write" ++ show w tsanLoad :: Env -> AlignmentSpec -> CmmType -> CmmExpr ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1512,6 +1512,11 @@ instance Diagnostic TcRnMessage where <+> quotes (ppr ps_name) <> colon) 2 (pprPatSynInvalidRhsReason ps_name lpat args reason) , text "RHS pattern:" <+> ppr lpat ] + TcRnCannotDefaultConcrete frr + -> mkSimpleDecorated $ + ppr (frr_context frr) $$ + text "cannot be assigned a fixed runtime representation," <+> + text "not even by defaulting." diagnosticReason = \case TcRnUnknownMessage m @@ -2006,6 +2011,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnPatSynInvalidRhs{} -> ErrorWithoutFlag + TcRnCannotDefaultConcrete{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2518,6 +2525,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnPatSynInvalidRhs{} -> noHints + TcRnCannotDefaultConcrete{} + -> [SuggestAddTypeSignatures UnnamedBinding] diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -3356,6 +3356,16 @@ data TcRnMessage where -> !PatSynInvalidRhsReason -- ^ The number of equation arguments -> TcRnMessage + {- TcRnCannotDefaultConcrete is an error occurring when a concrete + type variable cannot be defaulted. + + Test cases: + T23153 + -} + TcRnCannotDefaultConcrete + :: !FixedRuntimeRepOrigin + -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -908,7 +908,7 @@ tcExprWithSig expr hs_ty loc = getLocA (dropWildCards hs_ty) ctxt = ExprSigCtxt (lhsSigWcTypeContextSpan hs_ty) -tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType) +tcExprSig :: UserTypeCtxt -> LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcSigmaType) tcExprSig ctxt expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc }) = setSrcSpan loc $ -- Sets the location for the implication constraint do { let poly_ty = idType poly_id ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1651,7 +1651,7 @@ canEqTyVarFunEq :: CtEvidence -- :: lhs ~ (rhs |> mco) -> MCoercion -- :: kind(rhs) ~N kind(lhs) -> TcS (StopOrContinue Ct) canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco - = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv1 rhs + = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv1 rhs ; if | case is_touchable of { Untouchable -> False; _ -> True } , cterHasNoProblem $ checkTyVarEq tv1 rhs `cterRemoveProblem` cteTypeFamily @@ -2440,7 +2440,7 @@ tryToSolveByUnification tv ; dont_unify } | otherwise - = do { is_touchable <- touchabilityTest (ctEvFlavour ev) tv rhs + = do { (is_touchable, rhs) <- touchabilityTest (ctEvFlavour ev) tv rhs ; traceTcS "tryToSolveByUnification" (vcat [ ppr tv <+> char '~' <+> ppr rhs , ppr is_touchable ]) ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1326,35 +1326,37 @@ instance Outputable TouchabilityTestResult where ppr (TouchableOuterLevel tvs lvl) = text "TouchableOuterLevel" <> parens (ppr lvl <+> ppr tvs) ppr Untouchable = text "Untouchable" -touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS TouchabilityTestResult --- This is the key test for untouchability: +touchabilityTest :: CtFlavour -> TcTyVar -> TcType -> TcS (TouchabilityTestResult, TcType) +-- ^ This is the key test for untouchability: -- See Note [Unification preconditions] in GHC.Tc.Utils.Unify -- and Note [Solve by unification] in GHC.Tc.Solver.Interact +-- +-- Returns a new rhs type, as this function can turn make some metavariables concrete. touchabilityTest flav tv1 rhs | flav /= Given -- See Note [Do not unify Givens] , MetaTv { mtv_tclvl = tv_lvl, mtv_info = info } <- tcTyVarDetails tv1 - = do { can_continue_solving <- wrapTcS $ startSolvingByUnification info rhs - ; if not can_continue_solving - then return Untouchable - else - do { ambient_lvl <- getTcLevel + = do { continue_solving <- wrapTcS $ startSolvingByUnification info rhs + ; case continue_solving of + { Nothing -> return (Untouchable, rhs) + ; Just rhs -> + do { let (free_metas, free_skols) = partition isPromotableMetaTyVar $ + nonDetEltsUniqSet $ + tyCoVarsOfType rhs + ; ambient_lvl <- getTcLevel ; given_eq_lvl <- getInnermostGivenEqLevel ; if | tv_lvl `sameDepthAs` ambient_lvl - -> return TouchableSameLevel + -> return (TouchableSameLevel, rhs) | tv_lvl `deeperThanOrSame` given_eq_lvl -- No intervening given equalities , all (does_not_escape tv_lvl) free_skols -- No skolem escapes - -> return (TouchableOuterLevel free_metas tv_lvl) + -> return (TouchableOuterLevel free_metas tv_lvl, rhs) | otherwise - -> return Untouchable } } + -> return (Untouchable, rhs) } } } | otherwise - = return Untouchable + = return (Untouchable, rhs) where - (free_metas, free_skols) = partition isPromotableMetaTyVar $ - nonDetEltsUniqSet $ - tyCoVarsOfType rhs does_not_escape tv_lvl fv | isTyVar fv = tv_lvl `deeperThanOrSame` tcTyVarLevel fv @@ -2165,23 +2167,21 @@ breakTyEqCycle_maybe ev cte_result lhs rhs -- See Detail (8) of the Note. = do { should_break <- final_check - ; if should_break then do { redn <- go rhs - ; return (Just redn) } - else return Nothing } + ; mapM go should_break } where flavour = ctEvFlavour ev eq_rel = ctEvEqRel ev final_check = case flavour of - Given -> return True + Given -> return $ Just rhs Wanted -- Wanteds work only with a touchable tyvar on the left -- See "Wanted" section of the Note. | TyVarLHS lhs_tv <- lhs -> - do { result <- touchabilityTest Wanted lhs_tv rhs + do { (result, rhs) <- touchabilityTest Wanted lhs_tv rhs ; return $ case result of - Untouchable -> False - _ -> True } - | otherwise -> return False + Untouchable -> Nothing + _ -> Just rhs } + | otherwise -> return Nothing -- This could be considerably more efficient. See Detail (5) of Note. go :: TcType -> TcS ReductionN ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecursiveDo #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -480,7 +481,16 @@ newInferExpType :: TcM ExpType newInferExpType = new_inferExpType Nothing newInferExpTypeFRR :: FixedRuntimeRepContext -> TcM ExpTypeFRR -newInferExpTypeFRR frr_orig = new_inferExpType (Just frr_orig) +newInferExpTypeFRR frr_orig + = do { th_stage <- getStage + ; if + -- See [Wrinkle: Typed Template Haskell] + -- in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. + | Brack _ (TcPending {}) <- th_stage + -> new_inferExpType Nothing + + | otherwise + -> new_inferExpType (Just frr_orig) } new_inferExpType :: Maybe FixedRuntimeRepContext -> TcM ExpType new_inferExpType mb_frr_orig @@ -536,20 +546,28 @@ expTypeToType (Infer inf_res) = inferResultToType inf_res inferResultToType :: InferResult -> TcM Type inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl - , ir_ref = ref }) + , ir_ref = ref + , ir_frr = mb_frr }) = do { mb_inferred_ty <- readTcRef ref ; tau <- case mb_inferred_ty of Just ty -> do { ensureMonoType ty -- See Note [inferResultToType] ; return ty } - Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy - ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) - -- See Note [TcLevel of ExpType] + Nothing -> do { tau <- new_meta ; writeMutVar ref (Just tau) ; return tau } ; traceTc "Forcing ExpType to be monomorphic:" (ppr u <+> text ":=" <+> ppr tau) ; return tau } + where + -- See Note [TcLevel of ExpType] + new_meta = case mb_frr of + Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy + ; newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) } + Just frr -> mdo { rr <- newConcreteTyVarAtLevel conc_orig tc_lvl runtimeRepTy + ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) + ; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr + ; return tau } {- Note [inferResultToType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -872,6 +890,13 @@ newTauTvDetailsAtLevel tclvl , mtv_ref = ref , mtv_tclvl = tclvl }) } +newConcreteTvDetailsAtLevel :: ConcreteTvOrigin -> TcLevel -> TcM TcTyVarDetails +newConcreteTvDetailsAtLevel conc_orig tclvl + = do { ref <- newMutVar Flexi + ; return (MetaTv { mtv_info = ConcreteTv conc_orig + , mtv_ref = ref + , mtv_tclvl = tclvl }) } + cloneMetaTyVar :: TcTyVar -> TcM TcTyVar cloneMetaTyVar tv = assert (isTcTyVar tv) $ @@ -917,7 +942,7 @@ isUnfilledMetaTyVar tv -------------------- -- Works with both type and kind variables -writeMetaTyVar :: TcTyVar -> TcType -> TcM () +writeMetaTyVar :: HasDebugCallStack => TcTyVar -> TcType -> TcM () -- Write into a currently-empty MetaTyVar writeMetaTyVar tyvar ty @@ -935,7 +960,7 @@ writeMetaTyVar tyvar ty = massertPpr False (text "Writing to non-meta tyvar" <+> ppr tyvar) -------------------- -writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM () +writeMetaTyVarRef :: HasDebugCallStack => TcTyVar -> TcRef MetaDetails -> TcType -> TcM () -- Here the tyvar is for error checking only; -- the ref cell must be for the same tyvar writeMetaTyVarRef tyvar ref ty @@ -1100,6 +1125,13 @@ newMetaTyVarTyAtLevel tc_lvl kind ; name <- newMetaTyVarName (fsLit "p") ; return (mkTyVarTy (mkTcTyVar name kind details)) } +newConcreteTyVarAtLevel :: ConcreteTvOrigin -> TcLevel -> TcKind -> TcM TcType +newConcreteTyVarAtLevel conc_orig tc_lvl kind + = do { details <- newConcreteTvDetailsAtLevel conc_orig tc_lvl + ; name <- newMetaTyVarName (fsLit "c") + ; return (mkTyVarTy (mkTcTyVar name kind details)) } + + {- ********************************************************************* * * Finding variables to quantify over @@ -2235,7 +2267,7 @@ a \/\a in the final result but all the occurrences of a will be zonked to () * * ********************************************************************* -} -promoteMetaTyVarTo :: TcLevel -> TcTyVar -> TcM Bool +promoteMetaTyVarTo :: HasDebugCallStack => TcLevel -> TcTyVar -> TcM Bool -- When we float a constraint out of an implication we must restore -- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion @@ -2253,7 +2285,7 @@ promoteMetaTyVarTo tclvl tv = return False -- Returns whether or not *any* tyvar is defaulted -promoteTyVarSet :: TcTyVarSet -> TcM Bool +promoteTyVarSet :: HasDebugCallStack => TcTyVarSet -> TcM Bool promoteTyVarSet tvs = do { tclvl <- getTcLevel ; bools <- mapM (promoteMetaTyVarTo tclvl) $ ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2072,10 +2072,10 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles , cterHasNoProblem (checkTyVarEq tv1 ty2) -- See Note [Prevent unification with type families] - = do { can_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2 - ; if not can_continue_solving - then not_ok_so_defer - else + = do { mb_continue_solving <- startSolvingByUnification (metaTyVarInfo tv1) ty2 + ; case mb_continue_solving of + { Nothing -> not_ok_so_defer + ; Just ty2 -> do { co_k <- uType KindLevel kind_origin (typeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) @@ -2089,9 +2089,9 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 then do { writeMetaTyVar tv1 ty2 ; return (mkNomReflCo ty2) } - else defer }} -- This cannot be solved now. See GHC.Tc.Solver.Canonical - -- Note [Equalities with incompatible kinds] for how - -- this will be dealt with in the solver + else defer }}} -- This cannot be solved now. See GHC.Tc.Solver.Canonical + -- Note [Equalities with incompatible kinds] for how + -- this will be dealt with in the solver | otherwise = not_ok_so_defer @@ -2111,39 +2111,38 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- | Checks (TYVAR-TV), (COERCION-HOLE) and (CONCRETE) of -- Note [Unification preconditions]; returns True if these conditions -- are satisfied. But see the Note for other preconditions, too. -startSolvingByUnification :: MetaInfo -> TcType -- zonked - -> TcM Bool +startSolvingByUnification :: MetaInfo -> TcType -- zonked + -> TcM (Maybe TcType) startSolvingByUnification _ xi | hasCoercionHoleTy xi -- (COERCION-HOLE) check - = return False + = return Nothing startSolvingByUnification info xi = case info of - CycleBreakerTv -> return False + CycleBreakerTv -> return Nothing ConcreteTv conc_orig -> - do { (_, not_conc_reasons) <- makeTypeConcrete conc_orig xi + do { (xi, not_conc_reasons) <- makeTypeConcrete conc_orig xi -- NB: makeTypeConcrete has the side-effect of turning -- some TauTvs into ConcreteTvs, e.g. -- alpha[conc] ~# TYPE (TupleRep '[ beta[tau], IntRep ]) -- will write `beta[tau] := beta[conc]`. -- - -- We don't need to track these unifications for the purposes - -- of constraint solving (e.g. updating tcs_unified or tcs_unif_lvl), - -- as they don't unlock any further progress. + -- We return the new type, so that callers of this function + -- aren't required to zonk. ; case not_conc_reasons of - [] -> return True - _ -> return False } + [] -> return $ Just xi + _ -> return Nothing } TyVarTv -> case getTyVar_maybe xi of - Nothing -> return False + Nothing -> return Nothing Just tv -> case tcTyVarDetails tv of -- (TYVAR-TV) wrinkle - SkolemTv {} -> return True - RuntimeUnk -> return True + SkolemTv {} -> return $ Just xi + RuntimeUnk -> return $ Just xi MetaTv { mtv_info = info } -> case info of - TyVarTv -> return True - _ -> return False - _ -> return True + TyVarTv -> return $ Just xi + _ -> return Nothing + _ -> return $ Just xi swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool swapOverTyVars is_given tv1 tv2 ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -56,6 +56,7 @@ import GHC.Tc.Utils.TcType import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) import GHC.Tc.Types.Evidence +import GHC.Tc.Errors.Types import GHC.Core.TyCo.Ppr ( pprTyVar ) import GHC.Core.TyCon @@ -1737,7 +1738,7 @@ change. But in some cases it makes a HUGE difference: see test T9198 and #19668. So yes, it seems worth it. -} -zonkTyVarOcc :: ZonkEnv -> TcTyVar -> TcM Type +zonkTyVarOcc :: HasDebugCallStack => ZonkEnv -> TcTyVar -> TcM Type zonkTyVarOcc env@(ZonkEnv { ze_flexi = flexi , ze_tv_env = tv_env , ze_meta_tv_env = mtv_env_ref }) tv @@ -1810,6 +1811,9 @@ commitFlexi flexi tv zonked_kind | isMultiplicityTy zonked_kind -> do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv) ; return manyDataConTy } + | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv + -> do { addErr $ TcRnCannotDefaultConcrete origin + ; return (anyTypeOfKind zonked_kind) } | otherwise -> do { traceTc "Defaulting flexi tyvar to Any:" (pprTyVar tv) ; return (anyTypeOfKind zonked_kind) } ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -548,6 +548,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnPatSynArityMismatch" = 18365 GhcDiagnosticCode "PatSynNotInvertible" = 69317 GhcDiagnosticCode "PatSynUnboundVar" = 28572 + GhcDiagnosticCode "TcRnCannotDefaultConcrete" = 52083 -- IllegalNewtypeReason GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -113,32 +113,24 @@ as ``-Wno-...`` for every individual warning in the group. :category: Turns on all warning options that indicate potentially suspicious - code. The warnings that are *not* enabled by :ghc-flag:`-Wall` are + code. They include all warnings in :ghc-flag:`-Wextra`, plus: .. hlist:: :columns: 3 - * :ghc-flag:`-Wmonomorphism-restriction` - * :ghc-flag:`-Wimplicit-prelude` - * :ghc-flag:`-Wmissing-local-signatures` - * :ghc-flag:`-Wmissing-exported-signatures` - * :ghc-flag:`-Wmissing-export-lists` - * :ghc-flag:`-Wmissing-import-lists` - * :ghc-flag:`-Wmissing-home-modules` - * :ghc-flag:`-Widentities` - * :ghc-flag:`-Wredundant-constraints` - * :ghc-flag:`-Wpartial-fields` - * :ghc-flag:`-Wmissed-specialisations` - * :ghc-flag:`-Wall-missed-specialisations` - * :ghc-flag:`-Wcpp-undef` - * :ghc-flag:`-Wduplicate-constraints` - * :ghc-flag:`-Wmissing-deriving-strategies` - * :ghc-flag:`-Wunused-packages` - * :ghc-flag:`-Wunused-type-patterns` - * :ghc-flag:`-Wsafe` - * :ghc-flag:`-Wimplicit-lift` - * :ghc-flag:`-Wmissing-kind-signatures` - * :ghc-flag:`-Wunticked-promoted-constructors` + * :ghc-flag:`-Whi-shadowing` + * :ghc-flag:`-Wincomplete-record-updates` + * :ghc-flag:`-Wincomplete-uni-patterns` + * :ghc-flag:`-Wmissing-pattern-synonym-signatures` + * :ghc-flag:`-Wmissing-signatures` + * :ghc-flag:`-Wname-shadowing` + * :ghc-flag:`-Worphans` + * :ghc-flag:`-Wredundant-record-wildcards` + * :ghc-flag:`-Wstar-is-type` + * :ghc-flag:`-Wtrustworthy-safe` + * :ghc-flag:`-Wtype-defaults` + * :ghc-flag:`-Wunused-do-bind` + * :ghc-flag:`-Wunused-record-wildcards` .. ghc-flag:: -Weverything :shortdesc: enable all warnings supported by GHC ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -133,9 +133,6 @@ infixr 0 `par`, `pseq` ----------------------------------------------------------------------------- data ThreadId = ThreadId ThreadId# --- ToDo: data ThreadId = ThreadId (Weak ThreadId#) --- But since ThreadId# is unlifted, the Weak type must use open --- type variables. {- ^ A 'ThreadId' is an abstract type representing a handle to a thread. 'ThreadId' is an instance of 'Eq', 'Ord' and 'Show', where @@ -146,10 +143,9 @@ useful when debugging or diagnosing the behaviour of a concurrent program. /Note/: in GHC, if you have a 'ThreadId', you essentially have -a pointer to the thread itself. This means the thread itself can\'t be -garbage collected until you drop the 'ThreadId'. -This misfeature will hopefully be corrected at a later date. - +a pointer to the thread itself. This means the thread itself can\'t be +garbage collected until you drop the 'ThreadId'. This misfeature would +be difficult to correct while continuing to support 'threadStatus'. -} -- | @since 4.2.0.0 ===================================== libraries/base/changelog.md ===================================== @@ -16,10 +16,11 @@ ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) ## 4.18.0.0 *TBA* - + * Shipped with GHC 9.6.1 * `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified pointer types in foreign declarations when using `CApiFFI` extension. ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) * Add `forall a. Functor (p a)` superclass for `Bifunctor p` ([CLC proposal #91](https://github.com/haskell/core-libraries-committee/issues/91)) + * Add `forall a. Functor (p a)` superclass for `Bifunctor p`. * Add Functor instances for `(,,,,) a b c d`, `(,,,,,) a b c d e` and `(,,,,,) a b c d e f`. * Exceptions thrown by weak pointer finalizers can now be reported by setting @@ -91,6 +92,8 @@ ## 4.17.0.0 *August 2022* + * Shipped with GHC 9.4.1 + * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. * Add `Generically` and `Generically1` to `GHC.Generics` for deriving generic @@ -200,6 +203,8 @@ ## 4.16.0.0 *Nov 2021* + * Shipped with GHC 9.2.1 + * The unary tuple type, `Solo`, is now exported by `Data.Tuple`. * Add a `Typeable` constraint to `fromStaticPtr` in the class `GHC.StaticPtr.IsStatic`. @@ -260,6 +265,8 @@ ## 4.15.0.0 *Feb 2021* + * Shipped with GHC 9.0.1 + * `openFile` now calls the `open` system call with an `interruptible` FFI call, ensuring that the call can be interrupted with `SIGINT` on POSIX systems. ===================================== rts/StgMiscClosures.cmm ===================================== @@ -521,6 +521,7 @@ INFO_TABLE(stg_IND,1,0,IND,"IND","IND") (P_ node) { TICK_ENT_DYN_IND(); /* tick */ + ACQUIRE_FENCE; node = UNTAG(StgInd_indirectee(node)); TICK_ENT_VIA_NODE(); jump %GET_ENTRY(node) (node); @@ -529,6 +530,7 @@ INFO_TABLE(stg_IND,1,0,IND,"IND","IND") /* explicit stack */ { TICK_ENT_DYN_IND(); /* tick */ + ACQUIRE_FENCE; R1 = UNTAG(StgInd_indirectee(R1)); TICK_ENT_VIA_NODE(); jump %GET_ENTRY(R1) [R1]; @@ -539,6 +541,7 @@ INFO_TABLE(stg_IND_STATIC,1,0,IND_STATIC,"IND_STATIC","IND_STATIC") /* explicit stack */ { TICK_ENT_STATIC_IND(); /* tick */ + ACQUIRE_FENCE; R1 = UNTAG(StgInd_indirectee(R1)); TICK_ENT_VIA_NODE(); jump %GET_ENTRY(R1) [R1]; ===================================== rts/include/stg/SMP.h ===================================== @@ -214,23 +214,22 @@ EXTERN_INLINE void load_load_barrier(void); * examining a thunk being updated can see the indirectee. Consequently, a * thunk update (see rts/Updates.h) does the following: * - * 1. Use a release-fence to ensure that the indirectee is visible - * 2. Use a relaxed-store to place the new indirectee into the thunk's + * 1. Use a relaxed-store to place the new indirectee into the thunk's * indirectee field - * 3. use a release-store to set the info table to stg_BLACKHOLE (which + * 2. use a release-store to set the info table to stg_BLACKHOLE (which * represents an indirection) * * Blackholing a thunk (either eagerly, by GHC.StgToCmm.Bind.emitBlackHoleCode, * or lazily, by ThreadPaused.c:threadPaused) is done similarly. * - * Conversely, thunk entry (see the entry code of stg_BLACKHOLE in - * rts/StgMiscClosure) does the following: + * Conversely, indirection entry (see the entry code of stg_BLACKHOLE, stg_IND, + * and stg_IND_STATIC in rts/StgMiscClosure.cmm) does the following: * - * 1. We jump into the entry code for stg_BLACKHOLE; this of course implies - * that we have already read the thunk's info table pointer, which is done - * with a relaxed load. + * 1. We jump into the entry code for, e.g., stg_BLACKHOLE; this of course + * implies that we have already read the thunk's info table pointer, which + * is done with a relaxed load. * 2. use an acquire-fence to ensure that our view on the thunk is - * up-to-date. This synchronizes with step (3) in the update + * up-to-date. This synchronizes with step (2) in the update * procedure. * 3. relaxed-load the indirectee. Since thunks are updated at most * once we know that the fence in the last step has given us ===================================== rts/sm/NonMoving.c ===================================== @@ -395,7 +395,8 @@ Mutex concurrent_coll_finished_lock; * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * The nonmoving collector uses an approximate heuristic for reporting live * data quantity. Specifically, during mark we record how much live data we - * find in nonmoving_live_words. At the end of mark we declare this amount to + * find in nonmoving_segment_live_words. At the end of mark this is combined with nonmoving_large_words + * and nonmoving_compact_words, and we declare this amount to * be how much live data we have on in the nonmoving heap (by setting * oldest_gen->live_estimate). * @@ -540,7 +541,7 @@ Mutex concurrent_coll_finished_lock; * */ -memcount nonmoving_live_words = 0; +memcount nonmoving_segment_live_words = 0; // See Note [Sync phase marking budget]. MarkBudget sync_phase_marking_budget = 200000; @@ -682,10 +683,11 @@ static void nonmovingPrepareMark(void) dbl_link_onto(bd, &nonmoving_large_objects); } n_nonmoving_large_blocks += oldest_gen->n_large_blocks; + nonmoving_large_words += oldest_gen->n_large_words; oldest_gen->large_objects = NULL; oldest_gen->n_large_words = 0; oldest_gen->n_large_blocks = 0; - nonmoving_live_words = 0; + nonmoving_segment_live_words = 0; // Clear compact object mark bits for (bdescr *bd = nonmoving_compact_objects; bd; bd = bd->link) { @@ -700,6 +702,7 @@ static void nonmovingPrepareMark(void) dbl_link_onto(bd, &nonmoving_compact_objects); } n_nonmoving_compact_blocks += oldest_gen->n_compact_blocks; + nonmoving_compact_words += oldest_gen->n_compact_blocks * BLOCK_SIZE_W; oldest_gen->n_compact_blocks = 0; oldest_gen->compact_objects = NULL; // TODO (osa): what about "in import" stuff?? @@ -1053,7 +1056,9 @@ concurrent_marking: freeMarkQueue(mark_queue); stgFree(mark_queue); - oldest_gen->live_estimate = nonmoving_live_words; + nonmoving_large_words = countOccupied(nonmoving_marked_large_objects); + nonmoving_compact_words = n_nonmoving_marked_compact_blocks * BLOCK_SIZE_W; + oldest_gen->live_estimate = nonmoving_segment_live_words + nonmoving_large_words + nonmoving_compact_words; oldest_gen->n_old_blocks = 0; resizeGenerations(); ===================================== rts/sm/NonMoving.h ===================================== @@ -122,7 +122,7 @@ struct NonmovingHeap { extern struct NonmovingHeap nonmovingHeap; -extern memcount nonmoving_live_words; +extern memcount nonmoving_segment_live_words; #if defined(THREADED_RTS) extern bool concurrent_coll_running; ===================================== rts/sm/NonMovingMark.c ===================================== @@ -76,6 +76,10 @@ static bool is_nonmoving_weak(StgWeak *weak); * consequently will trace the pointers of only one object per block. However, * this is okay since the only type of pinned object supported by GHC is the * pinned ByteArray#, which has no pointers. + * + * We need to take care that the stats department is made aware of the amount of + * live large (and compact) objects, since they no longer live on gen[i]->large_objects. + * Failing to do so caused #17574. */ bdescr *nonmoving_large_objects = NULL; @@ -83,6 +87,9 @@ bdescr *nonmoving_marked_large_objects = NULL; memcount n_nonmoving_large_blocks = 0; memcount n_nonmoving_marked_large_blocks = 0; +memcount nonmoving_large_words = 0; +memcount nonmoving_compact_words = 0; + bdescr *nonmoving_compact_objects = NULL; bdescr *nonmoving_marked_compact_objects = NULL; memcount n_nonmoving_compact_blocks = 0; @@ -1745,7 +1752,7 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) struct NonmovingSegment *seg = nonmovingGetSegment((StgPtr) p); nonmoving_block_idx block_idx = nonmovingGetBlockIdx((StgPtr) p); nonmovingSetMark(seg, block_idx); - nonmoving_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_); + nonmoving_segment_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_); } // If we found a indirection to shortcut keep going. ===================================== rts/sm/NonMovingMark.h ===================================== @@ -127,6 +127,11 @@ extern bdescr *nonmoving_large_objects, *nonmoving_marked_large_objects, extern memcount n_nonmoving_large_blocks, n_nonmoving_marked_large_blocks, n_nonmoving_compact_blocks, n_nonmoving_marked_compact_blocks; +// The size of live large/compact objects in words. +// Only updated at the end of nonmoving GC. +extern memcount nonmoving_large_words, + nonmoving_compact_words; + extern StgTSO *nonmoving_old_threads; extern StgWeak *nonmoving_old_weak_ptr_list; extern StgTSO *nonmoving_threads; ===================================== rts/sm/Storage.c ===================================== @@ -42,6 +42,7 @@ #include "GC.h" #include "Evac.h" #include "NonMovingAllocate.h" +#include "sm/NonMovingMark.h" #if defined(ios_HOST_OS) || defined(darwin_HOST_OS) #include "Hash.h" #endif @@ -1615,7 +1616,12 @@ W_ genLiveWords (generation *gen) W_ genLiveBlocks (generation *gen) { - return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks; + W_ nonmoving_blocks = 0; + // The nonmoving heap contains some blocks that live outside the regular generation structure. + if (gen == oldest_gen && RtsFlags.GcFlags.useNonmoving){ + nonmoving_blocks = n_nonmoving_large_blocks + n_nonmoving_marked_large_blocks + n_nonmoving_compact_blocks + n_nonmoving_marked_compact_blocks; + } + return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks + nonmoving_blocks; } W_ gcThreadLiveWords (uint32_t i, uint32_t g) @@ -1711,6 +1717,9 @@ StgWord calcTotalLargeObjectsW (void) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { totalW += generations[g].n_large_words; } + + totalW += nonmoving_large_words; + return totalW; } @@ -1722,6 +1731,9 @@ StgWord calcTotalCompactW (void) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { totalW += generations[g].n_compact_blocks * BLOCK_SIZE_W; } + + totalW += nonmoving_compact_words; + return totalW; } ===================================== testsuite/tests/rep-poly/RepPolyPatBind.stderr ===================================== @@ -17,3 +17,36 @@ RepPolyPatBind.hs:18:5: error: [GHC-55287] x, y :: a (# x, y #) = undefined in x + +RepPolyPatBind.hs:18:8: error: [GHC-55287] + • The pattern binding does not have a fixed runtime representation. + Its type is: + (# a0, b0 #) :: TYPE (TupleRep [k00, k10]) + Cannot unify ‘rep’ with the type variable ‘k00’ + because it is not a concrete ‘RuntimeRep’. + • In the pattern: (# x, y #) + In a pattern binding: (# x, y #) = undefined + In the expression: + let + x, y :: a + (# x, y #) = undefined + in x + • Relevant bindings include + foo :: () -> a (bound at RepPolyPatBind.hs:15:1) + +RepPolyPatBind.hs:18:11: error: [GHC-55287] + • The pattern binding does not have a fixed runtime representation. + Its type is: + (# a0, b0 #) :: TYPE (TupleRep [k00, k10]) + Cannot unify ‘rep’ with the type variable ‘k10’ + because it is not a concrete ‘RuntimeRep’. + • In the pattern: (# x, y #) + In a pattern binding: (# x, y #) = undefined + In the expression: + let + x, y :: a + (# x, y #) = undefined + in x + • Relevant bindings include + x :: a (bound at RepPolyPatBind.hs:18:8) + foo :: () -> a (bound at RepPolyPatBind.hs:15:1) ===================================== testsuite/tests/rep-poly/T23153.hs ===================================== @@ -0,0 +1,8 @@ +module T23153 where + +import GHC.Exts + +f :: forall r s (a :: TYPE (r s)). a -> () +f = f + +g h = f (h ()) ===================================== testsuite/tests/rep-poly/T23153.stderr ===================================== @@ -0,0 +1,15 @@ + +T23153.hs:8:1: error: [GHC-52083] + The argument ‘(h ())’ of ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23153.hs:8:1: error: [GHC-52083] + The argument ‘(h ())’ of ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23153.hs:8:1: error: [GHC-52083] + The argument ‘(h ())’ of ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/T23154.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PartialTypeSignatures #-} + +module T23154 where + +import GHC.Exts + +f x = x :: (_ :: (TYPE (_ _))) ===================================== testsuite/tests/rep-poly/T23154.stderr ===================================== @@ -0,0 +1,15 @@ + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23154.hs:7:1: error: [GHC-52083] + The first pattern in the equation for ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -116,3 +116,5 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T23051', normal, compile_fail, ['']) +test('T23153', normal, compile_fail, ['']) +test('T23154', normal, compile_fail, ['']) ===================================== testsuite/tests/rts/T17574.hs ===================================== @@ -0,0 +1,40 @@ +-- | Check that large objects are properly accounted for by GHC.Stats +module Main (main) where + +import Control.Monad +import Control.Exception +import Control.Concurrent +import System.Mem +import System.Exit +import GHC.Stats +import GHC.Compact +import Data.List (replicate) + +import qualified Data.ByteString.Char8 as BS + +doGC :: IO () +doGC = do + performMajorGC + threadDelay 1000 -- small delay to allow GC to run when using concurrent gc + +main :: IO () +main = do + let size = 4096*2 + largeString <- evaluate $ BS.replicate size 'A' + compactString <- compact $ replicate size 'A' + doGC + doGC -- run GC twice to make sure the objects end up in the oldest gen + stats <- getRTSStats + let large_obj_bytes = gcdetails_large_objects_bytes $ gc stats + let compact_obj_bytes = gcdetails_compact_bytes $ gc stats + -- assert that large_obj_bytes is at least as big as size + -- this indicates that `largeString` is being accounted for by the stats department + when (large_obj_bytes < fromIntegral size) $ do + putStrLn $ "large_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size + exitFailure + when (compact_obj_bytes < fromIntegral size) $ do + putStrLn $ "compact_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size + exitFailure + -- keep them alive + print $ BS.length largeString + print $ length $ getCompact compactString ===================================== testsuite/tests/rts/T17574.stdout ===================================== @@ -0,0 +1,2 @@ +8192 +8192 ===================================== testsuite/tests/rts/all.T ===================================== @@ -573,3 +573,5 @@ test('decodeMyStack_emptyListForMissingFlag', test('T22795a', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded']) test('T22795b', [only_ways(['normal']), js_skip], compile_and_run, ['-single-threaded']) test('T22795c', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded -single-threaded']) + +test('T17574', [js_skip], compile_and_run, ['-with-rtsopts -T']) ===================================== testsuite/tests/typecheck/should_fail/VtaFail.stderr ===================================== @@ -7,7 +7,7 @@ VtaFail.hs:7:16: error: [GHC-95781] answer_nosig = pairup_nosig @Int @Bool 5 True VtaFail.hs:14:17: error: [GHC-95781] - • Cannot apply expression of type ‘p1 -> p1’ + • Cannot apply expression of type ‘p0 -> p0’ to a visible type argument ‘Int’ • In the expression: (\ x -> x) @Int 12 In an equation for ‘answer_lambda’: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14d989e89d71a2d9bd02a6ca753a0ec80115a789...08285a6a2f84613b1ec439cd47a9cc6ed4427aac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14d989e89d71a2d9bd02a6ca753a0ec80115a789...08285a6a2f84613b1ec439cd47a9cc6ed4427aac You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 22:18:11 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 24 Mar 2023 18:18:11 -0400 Subject: [Git][ghc/ghc][wip/T22696] 14 commits: Refactor the constraint solver pipeline Message-ID: <641e21a334e6d_13561a94ec45c124988@gitlab.mail> Ryan Scott pushed to branch wip/T22696 at Glasgow Haskell Compiler / GHC Commits: e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 5cc1ddb2 by Ryan Scott at 2023-03-24T18:17:54-04:00 validDerivPred: Reject non-type-variable constraints in IrredPreds This brings the `IrredPred` case in sync with the general wisdom in `Note [Exotic derived instance contexts]`. Namely, we should reject arbitrarily complex constraints that are inferred from `deriving` clauses. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if it is, there is a clear migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 18 changed files: - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Canonical.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/100f0eb7a8f178d0dfc5213ac12cf9a66f309f3d...5cc1ddb273c47c07b1835b82c674355e51e2ae23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/100f0eb7a8f178d0dfc5213ac12cf9a66f309f3d...5cc1ddb273c47c07b1835b82c674355e51e2ae23 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 23:32:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 24 Mar 2023 19:32:42 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: base: Document GHC versions associated with past base versions in the changelog Message-ID: <641e331a79292_13561aa989158161019@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ac9736f0 by Li-yao Xia at 2023-03-24T19:32:21-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 1ffa4bdb by Teo Camarasu at 2023-03-24T19:32:23-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - 822ef5d0 by Teo Camarasu at 2023-03-24T19:32:23-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 25e085c1 by David Feuer at 2023-03-24T19:32:26-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - 38250725 by Ben Gamari at 2023-03-24T19:32:26-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - fe1bf91c by Bodigrim at 2023-03-24T19:32:33-04:00 Improve documentation of atomicModifyMutVar2# - - - - - 13 changed files: - compiler/GHC/Builtin/primops.txt.pp - libraries/base/GHC/Conc/Sync.hs - libraries/base/changelog.md - rts/StgMiscClosures.cmm - rts/include/stg/SMP.h - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/Storage.c - + testsuite/tests/rts/T17574.hs - + testsuite/tests/rts/T17574.stdout - testsuite/tests/rts/all.T Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2528,11 +2528,23 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp primop AtomicModifyMutVar2Op "atomicModifyMutVar2#" GenPrimOp MutVar# s a -> (a -> c) -> State# s -> (# State# s, a, c #) { Modify the contents of a 'MutVar#', returning the previous - contents and the result of applying the given function to the - previous contents. Note that this isn't strictly - speaking the correct type for this function; it should really be - @'MutVar#' s a -> (a -> (a,b)) -> 'State#' s -> (# 'State#' s, a, (a, b) #)@, - but we don't know about pairs here. } + contents @x :: a@ and the result of applying the given function to the + previous contents @f x :: c at . + + The @data@ type @c@ (not a @newtype@!) must be a record whose first field + is of lifted type @a :: Type@ and is not unpacked. For example, product + types @c ~ Solo a@ or @c ~ (a, b)@ work well. If the record type is both + monomorphic and strict in its first field, it's recommended to mark the + latter @{-# NOUNPACK #-}@ explicitly. + + Under the hood 'atomicModifyMutVar2#' atomically replaces a pointer to an + old @x :: a@ with a pointer to a selector thunk @fst r@, where + @fst@ is a selector for the first field of the record and @r@ is a + function application thunk @r = f x at . + + @atomicModifyIORef2Native@ from @atomic-modify-general@ package makes an + effort to reflect restrictions on @c@ faithfully, providing a + well-typed high-level wrapper.} with out_of_line = True has_side_effects = True ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -133,9 +133,6 @@ infixr 0 `par`, `pseq` ----------------------------------------------------------------------------- data ThreadId = ThreadId ThreadId# --- ToDo: data ThreadId = ThreadId (Weak ThreadId#) --- But since ThreadId# is unlifted, the Weak type must use open --- type variables. {- ^ A 'ThreadId' is an abstract type representing a handle to a thread. 'ThreadId' is an instance of 'Eq', 'Ord' and 'Show', where @@ -146,10 +143,9 @@ useful when debugging or diagnosing the behaviour of a concurrent program. /Note/: in GHC, if you have a 'ThreadId', you essentially have -a pointer to the thread itself. This means the thread itself can\'t be -garbage collected until you drop the 'ThreadId'. -This misfeature will hopefully be corrected at a later date. - +a pointer to the thread itself. This means the thread itself can\'t be +garbage collected until you drop the 'ThreadId'. This misfeature would +be difficult to correct while continuing to support 'threadStatus'. -} -- | @since 4.2.0.0 ===================================== libraries/base/changelog.md ===================================== @@ -16,10 +16,11 @@ ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) ## 4.18.0.0 *TBA* - + * Shipped with GHC 9.6.1 * `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified pointer types in foreign declarations when using `CApiFFI` extension. ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) * Add `forall a. Functor (p a)` superclass for `Bifunctor p` ([CLC proposal #91](https://github.com/haskell/core-libraries-committee/issues/91)) + * Add `forall a. Functor (p a)` superclass for `Bifunctor p`. * Add Functor instances for `(,,,,) a b c d`, `(,,,,,) a b c d e` and `(,,,,,) a b c d e f`. * Exceptions thrown by weak pointer finalizers can now be reported by setting @@ -91,6 +92,8 @@ ## 4.17.0.0 *August 2022* + * Shipped with GHC 9.4.1 + * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. * Add `Generically` and `Generically1` to `GHC.Generics` for deriving generic @@ -200,6 +203,8 @@ ## 4.16.0.0 *Nov 2021* + * Shipped with GHC 9.2.1 + * The unary tuple type, `Solo`, is now exported by `Data.Tuple`. * Add a `Typeable` constraint to `fromStaticPtr` in the class `GHC.StaticPtr.IsStatic`. @@ -260,6 +265,8 @@ ## 4.15.0.0 *Feb 2021* + * Shipped with GHC 9.0.1 + * `openFile` now calls the `open` system call with an `interruptible` FFI call, ensuring that the call can be interrupted with `SIGINT` on POSIX systems. ===================================== rts/StgMiscClosures.cmm ===================================== @@ -521,6 +521,7 @@ INFO_TABLE(stg_IND,1,0,IND,"IND","IND") (P_ node) { TICK_ENT_DYN_IND(); /* tick */ + ACQUIRE_FENCE; node = UNTAG(StgInd_indirectee(node)); TICK_ENT_VIA_NODE(); jump %GET_ENTRY(node) (node); @@ -529,6 +530,7 @@ INFO_TABLE(stg_IND,1,0,IND,"IND","IND") /* explicit stack */ { TICK_ENT_DYN_IND(); /* tick */ + ACQUIRE_FENCE; R1 = UNTAG(StgInd_indirectee(R1)); TICK_ENT_VIA_NODE(); jump %GET_ENTRY(R1) [R1]; @@ -539,6 +541,7 @@ INFO_TABLE(stg_IND_STATIC,1,0,IND_STATIC,"IND_STATIC","IND_STATIC") /* explicit stack */ { TICK_ENT_STATIC_IND(); /* tick */ + ACQUIRE_FENCE; R1 = UNTAG(StgInd_indirectee(R1)); TICK_ENT_VIA_NODE(); jump %GET_ENTRY(R1) [R1]; ===================================== rts/include/stg/SMP.h ===================================== @@ -214,23 +214,22 @@ EXTERN_INLINE void load_load_barrier(void); * examining a thunk being updated can see the indirectee. Consequently, a * thunk update (see rts/Updates.h) does the following: * - * 1. Use a release-fence to ensure that the indirectee is visible - * 2. Use a relaxed-store to place the new indirectee into the thunk's + * 1. Use a relaxed-store to place the new indirectee into the thunk's * indirectee field - * 3. use a release-store to set the info table to stg_BLACKHOLE (which + * 2. use a release-store to set the info table to stg_BLACKHOLE (which * represents an indirection) * * Blackholing a thunk (either eagerly, by GHC.StgToCmm.Bind.emitBlackHoleCode, * or lazily, by ThreadPaused.c:threadPaused) is done similarly. * - * Conversely, thunk entry (see the entry code of stg_BLACKHOLE in - * rts/StgMiscClosure) does the following: + * Conversely, indirection entry (see the entry code of stg_BLACKHOLE, stg_IND, + * and stg_IND_STATIC in rts/StgMiscClosure.cmm) does the following: * - * 1. We jump into the entry code for stg_BLACKHOLE; this of course implies - * that we have already read the thunk's info table pointer, which is done - * with a relaxed load. + * 1. We jump into the entry code for, e.g., stg_BLACKHOLE; this of course + * implies that we have already read the thunk's info table pointer, which + * is done with a relaxed load. * 2. use an acquire-fence to ensure that our view on the thunk is - * up-to-date. This synchronizes with step (3) in the update + * up-to-date. This synchronizes with step (2) in the update * procedure. * 3. relaxed-load the indirectee. Since thunks are updated at most * once we know that the fence in the last step has given us ===================================== rts/sm/NonMoving.c ===================================== @@ -395,7 +395,8 @@ Mutex concurrent_coll_finished_lock; * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * The nonmoving collector uses an approximate heuristic for reporting live * data quantity. Specifically, during mark we record how much live data we - * find in nonmoving_live_words. At the end of mark we declare this amount to + * find in nonmoving_segment_live_words. At the end of mark this is combined with nonmoving_large_words + * and nonmoving_compact_words, and we declare this amount to * be how much live data we have on in the nonmoving heap (by setting * oldest_gen->live_estimate). * @@ -540,7 +541,7 @@ Mutex concurrent_coll_finished_lock; * */ -memcount nonmoving_live_words = 0; +memcount nonmoving_segment_live_words = 0; // See Note [Sync phase marking budget]. MarkBudget sync_phase_marking_budget = 200000; @@ -682,10 +683,11 @@ static void nonmovingPrepareMark(void) dbl_link_onto(bd, &nonmoving_large_objects); } n_nonmoving_large_blocks += oldest_gen->n_large_blocks; + nonmoving_large_words += oldest_gen->n_large_words; oldest_gen->large_objects = NULL; oldest_gen->n_large_words = 0; oldest_gen->n_large_blocks = 0; - nonmoving_live_words = 0; + nonmoving_segment_live_words = 0; // Clear compact object mark bits for (bdescr *bd = nonmoving_compact_objects; bd; bd = bd->link) { @@ -700,6 +702,7 @@ static void nonmovingPrepareMark(void) dbl_link_onto(bd, &nonmoving_compact_objects); } n_nonmoving_compact_blocks += oldest_gen->n_compact_blocks; + nonmoving_compact_words += oldest_gen->n_compact_blocks * BLOCK_SIZE_W; oldest_gen->n_compact_blocks = 0; oldest_gen->compact_objects = NULL; // TODO (osa): what about "in import" stuff?? @@ -1053,7 +1056,9 @@ concurrent_marking: freeMarkQueue(mark_queue); stgFree(mark_queue); - oldest_gen->live_estimate = nonmoving_live_words; + nonmoving_large_words = countOccupied(nonmoving_marked_large_objects); + nonmoving_compact_words = n_nonmoving_marked_compact_blocks * BLOCK_SIZE_W; + oldest_gen->live_estimate = nonmoving_segment_live_words + nonmoving_large_words + nonmoving_compact_words; oldest_gen->n_old_blocks = 0; resizeGenerations(); ===================================== rts/sm/NonMoving.h ===================================== @@ -122,7 +122,7 @@ struct NonmovingHeap { extern struct NonmovingHeap nonmovingHeap; -extern memcount nonmoving_live_words; +extern memcount nonmoving_segment_live_words; #if defined(THREADED_RTS) extern bool concurrent_coll_running; ===================================== rts/sm/NonMovingMark.c ===================================== @@ -76,6 +76,10 @@ static bool is_nonmoving_weak(StgWeak *weak); * consequently will trace the pointers of only one object per block. However, * this is okay since the only type of pinned object supported by GHC is the * pinned ByteArray#, which has no pointers. + * + * We need to take care that the stats department is made aware of the amount of + * live large (and compact) objects, since they no longer live on gen[i]->large_objects. + * Failing to do so caused #17574. */ bdescr *nonmoving_large_objects = NULL; @@ -83,6 +87,9 @@ bdescr *nonmoving_marked_large_objects = NULL; memcount n_nonmoving_large_blocks = 0; memcount n_nonmoving_marked_large_blocks = 0; +memcount nonmoving_large_words = 0; +memcount nonmoving_compact_words = 0; + bdescr *nonmoving_compact_objects = NULL; bdescr *nonmoving_marked_compact_objects = NULL; memcount n_nonmoving_compact_blocks = 0; @@ -1745,7 +1752,7 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) struct NonmovingSegment *seg = nonmovingGetSegment((StgPtr) p); nonmoving_block_idx block_idx = nonmovingGetBlockIdx((StgPtr) p); nonmovingSetMark(seg, block_idx); - nonmoving_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_); + nonmoving_segment_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_); } // If we found a indirection to shortcut keep going. ===================================== rts/sm/NonMovingMark.h ===================================== @@ -127,6 +127,11 @@ extern bdescr *nonmoving_large_objects, *nonmoving_marked_large_objects, extern memcount n_nonmoving_large_blocks, n_nonmoving_marked_large_blocks, n_nonmoving_compact_blocks, n_nonmoving_marked_compact_blocks; +// The size of live large/compact objects in words. +// Only updated at the end of nonmoving GC. +extern memcount nonmoving_large_words, + nonmoving_compact_words; + extern StgTSO *nonmoving_old_threads; extern StgWeak *nonmoving_old_weak_ptr_list; extern StgTSO *nonmoving_threads; ===================================== rts/sm/Storage.c ===================================== @@ -42,6 +42,7 @@ #include "GC.h" #include "Evac.h" #include "NonMovingAllocate.h" +#include "sm/NonMovingMark.h" #if defined(ios_HOST_OS) || defined(darwin_HOST_OS) #include "Hash.h" #endif @@ -1615,7 +1616,12 @@ W_ genLiveWords (generation *gen) W_ genLiveBlocks (generation *gen) { - return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks; + W_ nonmoving_blocks = 0; + // The nonmoving heap contains some blocks that live outside the regular generation structure. + if (gen == oldest_gen && RtsFlags.GcFlags.useNonmoving){ + nonmoving_blocks = n_nonmoving_large_blocks + n_nonmoving_marked_large_blocks + n_nonmoving_compact_blocks + n_nonmoving_marked_compact_blocks; + } + return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks + nonmoving_blocks; } W_ gcThreadLiveWords (uint32_t i, uint32_t g) @@ -1711,6 +1717,9 @@ StgWord calcTotalLargeObjectsW (void) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { totalW += generations[g].n_large_words; } + + totalW += nonmoving_large_words; + return totalW; } @@ -1722,6 +1731,9 @@ StgWord calcTotalCompactW (void) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { totalW += generations[g].n_compact_blocks * BLOCK_SIZE_W; } + + totalW += nonmoving_compact_words; + return totalW; } ===================================== testsuite/tests/rts/T17574.hs ===================================== @@ -0,0 +1,40 @@ +-- | Check that large objects are properly accounted for by GHC.Stats +module Main (main) where + +import Control.Monad +import Control.Exception +import Control.Concurrent +import System.Mem +import System.Exit +import GHC.Stats +import GHC.Compact +import Data.List (replicate) + +import qualified Data.ByteString.Char8 as BS + +doGC :: IO () +doGC = do + performMajorGC + threadDelay 1000 -- small delay to allow GC to run when using concurrent gc + +main :: IO () +main = do + let size = 4096*2 + largeString <- evaluate $ BS.replicate size 'A' + compactString <- compact $ replicate size 'A' + doGC + doGC -- run GC twice to make sure the objects end up in the oldest gen + stats <- getRTSStats + let large_obj_bytes = gcdetails_large_objects_bytes $ gc stats + let compact_obj_bytes = gcdetails_compact_bytes $ gc stats + -- assert that large_obj_bytes is at least as big as size + -- this indicates that `largeString` is being accounted for by the stats department + when (large_obj_bytes < fromIntegral size) $ do + putStrLn $ "large_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size + exitFailure + when (compact_obj_bytes < fromIntegral size) $ do + putStrLn $ "compact_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size + exitFailure + -- keep them alive + print $ BS.length largeString + print $ length $ getCompact compactString ===================================== testsuite/tests/rts/T17574.stdout ===================================== @@ -0,0 +1,2 @@ +8192 +8192 ===================================== testsuite/tests/rts/all.T ===================================== @@ -573,3 +573,5 @@ test('decodeMyStack_emptyListForMissingFlag', test('T22795a', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded']) test('T22795b', [only_ways(['normal']), js_skip], compile_and_run, ['-single-threaded']) test('T22795c', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded -single-threaded']) + +test('T17574', [js_skip], compile_and_run, ['-with-rtsopts -T']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08285a6a2f84613b1ec439cd47a9cc6ed4427aac...fe1bf91cd3ab288f29ea956f772d3d6b2134a56c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08285a6a2f84613b1ec439cd47a9cc6ed4427aac...fe1bf91cd3ab288f29ea956f772d3d6b2134a56c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 24 23:38:57 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 24 Mar 2023 19:38:57 -0400 Subject: [Git][ghc/ghc][wip/T21909] Constraint simplification loop now depends on `ExpansionFuel` Message-ID: <641e34915febc_13561aa9899a017371c@gitlab.mail> Apoorv Ingle pushed to branch wip/T21909 at Glasgow Haskell Compiler / GHC Commits: f5c3ae02 by Apoorv Ingle at 2023-03-06T08:40:40-06:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - 11 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/Constants.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - docs/users_guide/expected-undocumented-flags.txt - + testsuite/tests/typecheck/should_compile/T21909.hs - + testsuite/tests/typecheck/should_compile/T21909b.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Class.hs ===================================== @@ -17,8 +17,8 @@ module GHC.Core.Class ( mkClass, mkAbstractClass, classTyVars, classArity, classKey, className, classATs, classATItems, classTyCon, classMethods, classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta, - classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, classHasFds, - isAbstractClass, + classHasSCs, classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, + classHasFds, isAbstractClass, ) where import GHC.Prelude @@ -295,6 +295,9 @@ classSCTheta (Class { classBody = ConcreteClass { cls_sc_theta = theta_stuff }}) = theta_stuff classSCTheta _ = [] +classHasSCs :: Class -> Bool +classHasSCs cls = not (null (classSCTheta cls)) + classTvsFds :: Class -> ([TyVar], [FunDep TyVar]) classTvsFds c = (classTyVars c, classFunDeps c) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -517,7 +517,15 @@ data DynFlags = DynFlags { reductionDepth :: IntWithInf, -- ^ Typechecker maximum stack depth solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver -- Typically only 1 is needed - + givensFuel :: Int, -- ^ Number of layers of superclass expansion for givens + -- Should be < solverIterations + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + wantedsFuel :: Int, -- ^ Number of layers of superclass expansion for wanteds + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] + qcsFuel :: Int, -- ^ Number of layers of superclass expansion for quantified constraints + -- Should be < givensFuel + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] homeUnitId_ :: UnitId, -- ^ Target home unit-id homeUnitInstanceOf_ :: Maybe UnitId, -- ^ Id of the unit to instantiate homeUnitInstantiations_ :: [(ModuleName, Module)], -- ^ Module instantiations @@ -1148,6 +1156,9 @@ defaultDynFlags mySettings = mainFunIs = Nothing, reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, + givensFuel = mAX_GIVENS_FUEL, + wantedsFuel = mAX_WANTEDS_FUEL, + qcsFuel = mAX_QC_FUEL, homeUnitId_ = mainUnitId, homeUnitInstanceOf_ = Nothing, @@ -2733,6 +2744,12 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { reductionDepth = treatZeroAsInf n })) , make_ord_flag defFlag "fconstraint-solver-iterations" (intSuffix (\n d -> d { solverIterations = treatZeroAsInf n })) + , make_ord_flag defFlag "fgivens-expansion-fuel" + (intSuffix (\n d -> d { givensFuel = n })) + , make_ord_flag defFlag "fwanteds-expansion-fuel" + (intSuffix (\n d -> d { wantedsFuel = n })) + , make_ord_flag defFlag "fqcs-expansion-fuel" + (intSuffix (\n d -> d { qcsFuel = n })) , (Deprecated, defFlag "fcontext-stack" (intSuffixM (\n d -> do { deprecate $ "use -freduction-depth=" ++ show n ++ " instead" ===================================== compiler/GHC/Settings/Constants.hs ===================================== @@ -30,6 +30,27 @@ mAX_REDUCTION_DEPTH = 200 mAX_SOLVER_ITERATIONS :: Int mAX_SOLVER_ITERATIONS = 4 +-- | In case of loopy quantified costraints constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_QC_FUEL :: Int +mAX_QC_FUEL = 3 + +-- | In case of loopy wanted constraints, +-- how many times should we allow superclass expansions +-- Should be less than mAX_GIVENS_FUEL +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_WANTEDS_FUEL :: Int +mAX_WANTEDS_FUEL = 1 + +-- | In case of loopy given constraints, +-- how many times should we allow superclass expansions +-- Should be less than max_SOLVER_ITERATIONS +-- See Note [Expanding Recursive Superclasses and ExpansionFuel] +mAX_GIVENS_FUEL :: Int +mAX_GIVENS_FUEL = 3 + wORD64_SIZE :: Int wORD64_SIZE = 8 ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -2338,6 +2338,10 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) do { new_given <- makeSuperClasses pending_given ; new_wanted <- makeSuperClasses pending_wanted ; solveSimpleGivens new_given -- Add the new Givens to the inert set + ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given + , text "new_given" <+> ppr new_given + , text "pending_wanted" <+> ppr pending_wanted + , text "new_wanted" <+> ppr new_wanted ]) ; simplify_loop n limit (not (null pending_given)) $ wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } -- (not (null pending_given)): see Note [Superclass iteration] @@ -2366,6 +2370,73 @@ superclasses. In that case we check whether the new Wanteds actually led to any new unifications, and iterate the implications only if so. -} +{- Note [Expanding Recursive Superclasses and ExpansionFuel] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the class declaration (T21909) + + class C [a] => C a where + foo :: a -> Int + +and suppose during type inference we obtain an implication constraint: + + forall a. C a => C [[a]] + +To solve this implication constraint, we first expand one layer of the superclass +of Given constraints, but not for Wanted constraints. +(See Note [Eagerly expand given superclasses] and Note [Why adding superclasses can help] +in GHC.Tc.Solver.Canonical.) We thus get: + + [G] g1 :: C a + [G] g2 :: C [a] -- new superclass layer from g1 + [W] w1 :: C [[a]] + +Now, we cannot solve `w1` directly from `g1` or `g2` as we may not have +any instances for C. So we expand a layer of superclasses of each Wanteds and Givens +that we haven't expanded yet. +This is done in `maybe_simplify_again`. And we get: + + [G] g1 :: C a + [G] g2 :: C [a] + [G] g3 :: C [[a]] -- new superclass layer from g2, can solve w1 + [W] w1 :: C [[a]] + [W] w2 :: C [[[a]]] -- new superclass layer from w1, not solvable + +Now, although we can solve `w1` using `g3` (obtained from expanding `g2`), +we have a new wanted constraint `w2` (obtained from expanding `w1`) that cannot be solved. +We thus make another go at solving in `maybe_simplify_again` by expanding more +layers of superclasses. This looping is futile as Givens will never be able to catch up with Wanteds. + +Side Note: In principle we don't actually need to /solve/ `w2`, as it is a superclass of `w1` +but we only expand it to expose any functional dependencies (see Note [The superclass story]) +But `w2` is a wanted constraint, so we will try to solve it like any other, +even though ultimately we will discard its evidence. + +Solution: Simply bound the maximum number of layers of expansion for +Givens and Wanteds, with ExpansionFuel. Give the Givens more fuel +(say 3 layers) than the Wanteds (say 1 layer). Now the Givens will +win. The Wanteds don't need much fuel: we are only expanding at all +to expose functional dependencies, and wantedFuel=1 means we will +expand a full recursive layer. If the superclass hierarchy is +non-recursive (the normal case) one layer is therefore full expansion. + +The default value for wantedFuel = Constants.max_WANTEDS_FUEL = 1. +The default value for givenFuel = Constants.max_GIVENS_FUEL = 3. +Both are configurable via the `-fgivens-fuel` and `-fwanteds-fuel` +compiler flags. + +There are two preconditions for the default fuel values: + (1) default givenFuel >= default wantedsFuel + (2) default givenFuel < solverIterations + +Precondition (1) ensures that we expand givens at least as many times as we expand wanted constraints +preferably givenFuel > wantedsFuel to avoid issues like T21909 while +the precondition (2) ensures that we do not reach the solver iteration limit and fail with a +more meaningful error message + +This also applies for quantified constraints; see `-fqcs-fuel` compiler flag and `QCI.qci_pend_sc` field. +-} + + solveNestedImplications :: Bag Implication -> TcS (Bag Implication) -- Precondition: the TcS inerts may contain unsolved simples which have ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -59,7 +59,7 @@ import Control.Monad import Data.Maybe ( isJust, isNothing ) import Data.List ( zip4 ) import GHC.Types.Basic - +import GHC.Driver.Session ( givensFuel, wantedsFuel, qcsFuel ) import qualified Data.Semigroup as S import Data.Bifunctor ( bimap ) @@ -154,9 +154,13 @@ canClassNC :: CtEvidence -> Class -> [Type] -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence canClassNC ev cls tys | isGiven ev -- See Note [Eagerly expand given superclasses] - = do { sc_cts <- mkStrictSuperClasses ev [] [] cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev [] [] cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canClass ev cls tys False } + ; canClass ev cls tys doNotExpand } + -- doNotExpand: We have already expanded superclasses for /this/ dict + -- so set the fuel to doNotExpand to avoid repeating expansion | CtWanted { ctev_rewriters = rewriters } <- ev , Just ip_name <- isCallStackPred cls tys @@ -168,7 +172,7 @@ canClassNC ev cls tys -- and Note [Solving CallStack constraints] in GHC.Tc.Solver.Types = do { -- First we emit a new constraint that will capture the -- given CallStack. - ; let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) + let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) -- We change the origin to IPOccOrigin so -- this rule does not fire again. -- See Note [Overview of implicit CallStacks] @@ -182,14 +186,20 @@ canClassNC ev cls tys (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs - ; canClass new_ev cls tys False -- No superclasses + ; canClass new_ev cls tys doNotExpand + -- doNotExpand: No superclasses for class CallStack + -- See invariants in CDictCan.cc_pend_sc } | otherwise - = canClass ev cls tys (has_scs cls) + = do { dflags <- getDynFlags + ; let fuel | classHasSCs cls = wantedsFuel dflags + | otherwise = doNotExpand + -- See Invariants in `CCDictCan.cc_pend_sc` + ; canClass ev cls tys fuel + } where - has_scs cls = not (null (classSCTheta cls)) loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev @@ -206,7 +216,7 @@ solveCallStack ev ev_cs = do canClass :: CtEvidence -> Class -> [Type] - -> Bool -- True <=> un-explored superclasses + -> ExpansionFuel -- n > 0 <=> un-explored superclasses -> TcS (StopOrContinue Ct) -- Precondition: EvVar is class evidence @@ -307,10 +317,11 @@ So here's the plan: 4. Go round to (2) again. This loop (2,3,4) is implemented in GHC.Tc.Solver.simpl_loop. -The cc_pend_sc flag in a CDictCan records whether the superclasses of +The cc_pend_sc field in a CDictCan records whether the superclasses of this constraint have been expanded. Specifically, in Step 3 we only -expand superclasses for constraints with cc_pend_sc set to true (i.e. -isPendingScDict holds). +expand superclasses for constraints with cc_pend_sc > 0 +(i.e. isPendingScDict holds). +See Note [Expanding Recursive Superclasses and ExpansionFuel] Why do we do this? Two reasons: @@ -337,7 +348,8 @@ our strategy. Consider f :: C a => a -> Bool f x = x==x Then canClassNC gets the [G] d1: C a constraint, and eager emits superclasses -G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its sc_pend flag set.) +G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its cc_pend_sc has pending +expansion fuel.) When processing d3 we find a match with d1 in the inert set, and we always keep the inert item (d1) if possible: see Note [Replacement vs keeping] in GHC.Tc.Solver.Interact. So d3 dies a quick, happy death. @@ -484,7 +496,6 @@ the sc_theta_ids at all. So our final construction is makeSuperClasses :: [Ct] -> TcS [Ct] -- Returns strict superclasses, transitively, see Note [The superclass story] --- See Note [The superclass story] -- The loop-breaking here follows Note [Expanding superclasses] in GHC.Tc.Utils.TcType -- Specifically, for an incoming (C t) constraint, we return all of (C t)'s -- superclasses, up to /and including/ the first repetition of C @@ -493,39 +504,45 @@ makeSuperClasses :: [Ct] -> TcS [Ct] -- class C [a] => D a -- makeSuperClasses (C x) will return (D x, C [x]) -- --- NB: the incoming constraints have had their cc_pend_sc flag already --- flipped to False, by isPendingScDict, so we are /obliged/ to at --- least produce the immediate superclasses +-- NB: the incoming constraint's superclass will consume a unit of fuel +-- Preconditions on `cts`: 1. They are either `CDictCan` or `CQuantCan` +-- 2. Their fuel (stored in cc_pend_sc or qci_pend_sc) is > 0 makeSuperClasses cts = concatMapM go cts where - go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys }) - = mkStrictSuperClasses ev [] [] cls tys - go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev })) + go (CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys, cc_pend_sc = fuel }) + = assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev [] [] cls tys + go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have -- class pred heads - mkStrictSuperClasses ev tvs theta cls tys + assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + mkStrictSuperClasses fuel ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) mkStrictSuperClasses - :: CtEvidence + :: ExpansionFuel -> CtEvidence -> [TyVar] -> ThetaType -- These two args are non-empty only when taking -- superclasses of a /quantified/ constraint -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys -mkStrictSuperClasses ev tvs theta cls tys - = mk_strict_superclasses (unitNameSet (className cls)) +-- Precondition: fuel > 0 +-- Postcondition: fuel for recursive superclass ct is one unit less than cls fuel +mkStrictSuperClasses fuel ev tvs theta cls tys + = mk_strict_superclasses (consumeFuel fuel) (unitNameSet (className cls)) ev tvs theta cls tys -mk_strict_superclasses :: NameSet -> CtEvidence +mk_strict_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return the immediate superclasses of (cls tys); -- and expand their superclasses, provided none of them are in rec_clss -- nor are repeated -mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) +-- The caller of this function is supposed to perform fuel book keeping +-- Precondition: fuel >= 0 +mk_strict_superclasses fuel rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) tvs theta cls tys = concatMapM do_one_given $ classSCSelIds cls @@ -543,7 +560,8 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) | otherwise = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred - ; mk_superclasses rec_clss given_ev tvs theta sc_pred } + ; assertFuelPrecondition fuel + $ mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys @@ -604,7 +622,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) newly_blocked (InstSkol _ head_size) = isJust (this_size `ltPatersonSize` head_size) newly_blocked _ = False -mk_strict_superclasses rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -619,7 +637,7 @@ mk_strict_superclasses rec_clss ev tvs theta cls tys do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses rec_clss sc_ev [] [] sc_pred } + ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -634,46 +652,53 @@ dependencies. See Note [Why adding superclasses can help] above. But no variables means no improvement; case closed. -} -mk_superclasses :: NameSet -> CtEvidence +mk_superclasses :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> PredType -> TcS [Ct] -- Return this constraint, plus its superclasses, if any -mk_superclasses rec_clss ev tvs theta pred +-- Precondition: fuel >= 0 +mk_superclasses fuel rec_clss ev tvs theta pred | ClassPred cls tys <- classifyPredType pred - = mk_superclasses_of rec_clss ev tvs theta cls tys + = assertFuelPrecondition fuel $ + mk_superclasses_of fuel rec_clss ev tvs theta cls tys | otherwise -- Superclass is not a class predicate = return [mkNonCanonical ev] -mk_superclasses_of :: NameSet -> CtEvidence +mk_superclasses_of :: ExpansionFuel -> NameSet -> CtEvidence -> [TyVar] -> ThetaType -> Class -> [Type] -> TcS [Ct] -- Always return this class constraint, -- and expand its superclasses -mk_superclasses_of rec_clss ev tvs theta cls tys +-- Precondition: fuel >= 0 +mk_superclasses_of fuel rec_clss ev tvs theta cls tys | loop_found = do { traceTcS "mk_superclasses_of: loop" (ppr cls <+> ppr tys) - ; return [this_ct] } -- cc_pend_sc of this_ct = True + ; assertFuelPrecondition fuel $ return [mk_this_ct fuel] } + -- cc_pend_sc of returning ct = fuel | otherwise = do { traceTcS "mk_superclasses_of" (vcat [ ppr cls <+> ppr tys , ppr (isCTupleClass cls) , ppr rec_clss ]) - ; sc_cts <- mk_strict_superclasses rec_clss' ev tvs theta cls tys - ; return (this_ct : sc_cts) } - -- cc_pend_sc of this_ct = False + ; sc_cts <- assertFuelPrecondition fuel $ + mk_strict_superclasses fuel rec_clss' ev tvs theta cls tys + ; return (mk_this_ct doNotExpand : sc_cts) } + -- doNotExpand: we have expanded this cls's superclasses, so + -- exhaust the associated constraint's fuel, + -- to avoid duplicate work where cls_nm = className cls loop_found = not (isCTupleClass cls) && cls_nm `elemNameSet` rec_clss -- Tuples never contribute to recursion, and can be nested rec_clss' = rec_clss `extendNameSet` cls_nm - - this_ct | null tvs, null theta - = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys - , cc_pend_sc = loop_found } - -- NB: If there is a loop, we cut off, so we have not - -- added the superclasses, hence cc_pend_sc = True - | otherwise - = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys - , qci_ev = ev - , qci_pend_sc = loop_found }) + mk_this_ct :: ExpansionFuel -> Ct + mk_this_ct fuel | null tvs, null theta + = CDictCan { cc_ev = ev, cc_class = cls, cc_tyargs = tys + , cc_pend_sc = fuel } + -- NB: If there is a loop, we cut off, so we have not + -- added the superclasses, hence cc_pend_sc = fuel + | otherwise + = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys + , qci_ev = ev + , qci_pend_sc = fuel }) {- Note [Equality superclasses in quantified constraints] @@ -828,19 +853,28 @@ canForAllNC :: CtEvidence -> [TyVar] -> TcThetaType -> TcPredType canForAllNC ev tvs theta pred | isGiven ev -- See Note [Eagerly expand given superclasses] , Just (cls, tys) <- cls_pred_tys_maybe - = do { sc_cts <- mkStrictSuperClasses ev tvs theta cls tys + = do { dflags <- getDynFlags + ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev tvs theta cls tys + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] ; emitWork sc_cts - ; canForAll ev False } + ; canForAll ev doNotExpand } + -- doNotExpand: as we have already (eagerly) expanded superclasses for this class | otherwise - = canForAll ev (isJust cls_pred_tys_maybe) - + = do { dflags <- getDynFlags + ; let fuel | Just (cls, _) <- cls_pred_tys_maybe + , classHasSCs cls = qcsFuel dflags + -- See invariants (a) and (b) in QCI.qci_pend_sc + -- qcsFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + -- See Note [Quantified constraints] + | otherwise = doNotExpand + ; canForAll ev fuel } where cls_pred_tys_maybe = getClassPredTys_maybe pred -canForAll :: CtEvidence -> Bool -> TcS (StopOrContinue Ct) +canForAll :: CtEvidence -> ExpansionFuel -> TcS (StopOrContinue Ct) -- We have a constraint (forall as. blah => C tys) -canForAll ev pend_sc +canForAll ev fuel = do { -- First rewrite it to apply the current substitution let pred = ctEvPred ev ; (redn, rewriters) <- rewrite ev pred @@ -850,14 +884,14 @@ canForAll ev pend_sc -- (It takes a lot less code to rewrite before decomposing.) ; case classifyPredType (ctEvPred new_ev) of ForAllPred tvs theta pred - -> solveForAll new_ev tvs theta pred pend_sc + -> solveForAll new_ev tvs theta pred fuel _ -> pprPanic "canForAll" (ppr new_ev) } } -solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> Bool +solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel -> TcS (StopOrContinue Ct) solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) - tvs theta pred _pend_sc + tvs theta pred _fuel = -- See Note [Solving a Wanted forall-constraint] setLclEnv (ctLocEnv loc) $ -- This setLclEnv is important: the emitImplicationTcS uses that @@ -903,12 +937,12 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo _ -> pSizeType pred -- See Note [Solving a Given forall-constraint] -solveForAll ev@(CtGiven {}) tvs _theta pred pend_sc +solveForAll ev@(CtGiven {}) tvs _theta pred fuel = do { addInertForAll qci ; stopWith ev "Given forall-constraint" } where qci = QCI { qci_ev = ev, qci_tvs = tvs - , qci_pred = pred, qci_pend_sc = pend_sc } + , qci_pred = pred, qci_pend_sc = fuel } {- Note [Solving a Wanted forall-constraint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -513,10 +513,13 @@ getInertGivens ; return (filter isGivenCt all_cts) } getPendingGivenScs :: TcS [Ct] --- Find all inert Given dictionaries, or quantified constraints, --- whose cc_pend_sc flag is True --- and that belong to the current level --- Set their cc_pend_sc flag to False in the inert set, and return that Ct +-- Find all inert Given dictionaries, or quantified constraints, such that +-- 1. cc_pend_sc flag has fuel strictly > 0 +-- 2. belongs to the current level +-- For each such dictionary: +-- * Return it (with unmodified cc_pend_sc) in sc_pending +-- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand +-- to record that we have expanded superclasses for this dict getPendingGivenScs = do { lvl <- getTcLevel ; updRetInertCans (get_sc_pending lvl) } @@ -530,29 +533,33 @@ get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) sc_pending = sc_pend_insts ++ sc_pend_dicts sc_pend_dicts = foldDicts get_pending dicts [] - dicts' = foldr add dicts sc_pend_dicts + dicts' = foldr exhaustAndAdd dicts sc_pend_dicts (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc = True - -- but flipping the flag + get_pending :: Ct -> [Ct] -> [Ct] -- Get dicts with cc_pend_sc > 0 get_pending dict dicts - | Just dict' <- pendingScDict_maybe dict + | isPendingScDict dict , belongs_to_this_level (ctEvidence dict) - = dict' : dicts + = dict : dicts | otherwise = dicts - add :: Ct -> DictMap Ct -> DictMap Ct - add ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts - = addDict dicts cls tys ct - add ct _ = pprPanic "getPendingScDicts" (ppr ct) + exhaustAndAdd :: Ct -> DictMap Ct -> DictMap Ct + exhaustAndAdd ct@(CDictCan { cc_class = cls, cc_tyargs = tys }) dicts + -- exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + = addDict dicts cls tys (ct {cc_pend_sc = doNotExpand}) + exhaustAndAdd ct _ = pprPanic "getPendingScDicts" (ppr ct) get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) get_pending_inst cts qci@(QCI { qci_ev = ev }) | Just qci' <- pendingScInst_maybe qci , belongs_to_this_level ev - = (CQuantCan qci' : cts, qci') + = (CQuantCan qci : cts, qci') + -- qci' have their fuel exhausted + -- we don't want to expand these constraints again + -- qci is expanded | otherwise = (cts, qci) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -11,6 +11,8 @@ module GHC.Tc.Types.Constraint ( -- Canonical constraints Xi, Ct(..), Cts, + ExpansionFuel, doNotExpand, consumeFuel, pendingFuel, + assertFuelPrecondition, assertFuelPreconditionStrict, emptyCts, andCts, andManyCts, pprCts, singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList, isEmptyCts, @@ -138,8 +140,6 @@ import Data.Word ( Word8 ) import Data.List ( intersperse ) - - {- ************************************************************************ * * @@ -191,6 +191,37 @@ type Xi = TcType type Cts = Bag Ct +-- | Says how many layers of superclasses can we expand. +-- Invariant: ExpansionFuel should always be >= 0 +-- see Note [Expanding Recursive Superclasses and ExpansionFuel] +type ExpansionFuel = Int + +-- | Do not expand superclasses any further +doNotExpand :: ExpansionFuel +doNotExpand = 0 + +-- | Consumes one unit of fuel. +-- Precondition: fuel > 0 +consumeFuel :: ExpansionFuel -> ExpansionFuel +consumeFuel fuel = assertFuelPreconditionStrict fuel $ fuel - 1 + +-- | Returns True if we have any fuel left for superclass expansion +pendingFuel :: ExpansionFuel -> Bool +pendingFuel n = n > 0 + +insufficientFuelError :: SDoc +insufficientFuelError = text "Superclass expansion fuel should be > 0" + +-- | asserts if fuel is non-negative +assertFuelPrecondition :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPrecondition #-} +assertFuelPrecondition fuel = assertPpr (fuel >= 0) insufficientFuelError + +-- | asserts if fuel is strictly greater than 0 +assertFuelPreconditionStrict :: ExpansionFuel -> a -> a +{-# INLINE assertFuelPreconditionStrict #-} +assertFuelPreconditionStrict fuel = assertPpr (pendingFuel fuel) insufficientFuelError + data Ct -- Atomic canonical constraints = CDictCan { -- e.g. Num ty @@ -199,11 +230,12 @@ data Ct cc_class :: Class, cc_tyargs :: [Xi], -- cc_tyargs are rewritten w.r.t. inerts, so Xi - cc_pend_sc :: Bool + cc_pend_sc :: ExpansionFuel -- See Note [The superclass story] in GHC.Tc.Solver.Canonical - -- True <=> (a) cc_class has superclasses - -- (b) we have not (yet) added those - -- superclasses as Givens + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver + -- Invariants: cc_pend_sc > 0 <=> + -- (a) cc_class has superclasses + -- (b) those superclasses are not yet explored } | CIrredCan { -- These stand for yet-unusable predicates @@ -273,8 +305,13 @@ data QCInst -- A much simplified version of ClsInst -- Always Given , qci_tvs :: [TcTyVar] -- The tvs , qci_pred :: TcPredType -- The ty - , qci_pend_sc :: Bool -- Same as cc_pend_sc flag in CDictCan - -- Invariant: True => qci_pred is a ClassPred + , qci_pend_sc :: ExpansionFuel + -- Invariants: qci_pend_sc > 0 => + -- (a) qci_pred is a ClassPred + -- (b) this class has superclass(es), and + -- (c) the superclass(es) are not explored yet + -- Same as cc_pend_sc flag in CDictCan + -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver } instance Outputable QCInst where @@ -673,11 +710,11 @@ instance Outputable Ct where CEqCan {} -> text "CEqCan" CNonCanonical {} -> text "CNonCanonical" CDictCan { cc_pend_sc = psc } - | psc -> text "CDictCan(psc)" - | otherwise -> text "CDictCan" + | psc > 0 -> text "CDictCan" <> parens (text "psc" <+> ppr psc) + | otherwise -> text "CDictCan" CIrredCan { cc_reason = reason } -> text "CIrredCan" <> ppr reason - CQuantCan (QCI { qci_pend_sc = pend_sc }) - | pend_sc -> text "CQuantCan(psc)" + CQuantCan (QCI { qci_pend_sc = psc }) + | psc > 0 -> text "CQuantCan" <> parens (text "psc" <+> ppr psc) | otherwise -> text "CQuantCan" ----------------------------------- @@ -893,23 +930,24 @@ isUserTypeError pred = case getUserTypeErrorMsg pred of _ -> False isPendingScDict :: Ct -> Bool -isPendingScDict (CDictCan { cc_pend_sc = psc }) = psc --- Says whether this is a CDictCan with cc_pend_sc is True; +isPendingScDict (CDictCan { cc_pend_sc = f }) = pendingFuel f +-- Says whether this is a CDictCan with cc_pend_sc has positive fuel; -- i.e. pending un-expanded superclasses isPendingScDict _ = False pendingScDict_maybe :: Ct -> Maybe Ct --- Says whether this is a CDictCan with cc_pend_sc is True, --- AND if so flips the flag -pendingScDict_maybe ct@(CDictCan { cc_pend_sc = True }) - = Just (ct { cc_pend_sc = False }) +-- Says whether this is a CDictCan with cc_pend_sc has fuel left, +-- AND if so exhausts the fuel so that they are not expanded again +pendingScDict_maybe ct@(CDictCan { cc_pend_sc = f }) + | pendingFuel f = Just (ct { cc_pend_sc = doNotExpand }) + | otherwise = Nothing pendingScDict_maybe _ = Nothing pendingScInst_maybe :: QCInst -> Maybe QCInst -- Same as isPendingScDict, but for QCInsts -pendingScInst_maybe qci@(QCI { qci_pend_sc = True }) - = Just (qci { qci_pend_sc = False }) -pendingScInst_maybe _ = Nothing +pendingScInst_maybe qci@(QCI { qci_pend_sc = f }) + | pendingFuel f = Just (qci { qci_pend_sc = doNotExpand }) + | otherwise = Nothing superClassesMightHelp :: WantedConstraints -> Bool -- ^ True if taking superclasses of givens, or of wanteds (to perhaps @@ -928,11 +966,12 @@ superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics }) is_ip _ = False getPendingWantedScs :: Cts -> ([Ct], Cts) +-- in the return values [Ct] has original fuel while Cts has fuel exhausted getPendingWantedScs simples = mapAccumBagL get [] simples where - get acc ct | Just ct' <- pendingScDict_maybe ct - = (ct':acc, ct') + get acc ct | Just ct_exhausted <- pendingScDict_maybe ct + = (ct:acc, ct_exhausted) | otherwise = (acc, ct) ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -33,6 +33,9 @@ -fbang-patterns -fbuilding-cabal-package -fconstraint-solver-iterations +-fgivens-expansion-fuel +-fwanteds-expansion-fuel +-fqcs-expansion-fuel -fcontext-stack -fcross-module-specialize -fdiagnostics-color=always ===================================== testsuite/tests/typecheck/should_compile/T21909.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T21909 where + +import Data.Kind + +class (Monad m, MyMonad (Inner m)) => MyMonad m where + type Inner m :: Type -> Type + foo :: m Int + +works :: MyMonad m => m String +works = show <$> ((+ 1) <$> foo) + +fails :: MyMonad m => m String +fails = show <$> fooPlusOne + where + fooPlusOne = (+ 1) <$> foo + +alsoFails :: MyMonad m => m String +alsoFails = + let fooPlusOne = (+ 1) <$> foo + in show <$> fooPlusOne ===================================== testsuite/tests/typecheck/should_compile/T21909b.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses, FunctionalDependencies, MultiParamTypeClasses, GADTs #-} + +module T21909b where + +class C [a] => C a where + foo :: a -> Int + +bar :: C a => a -> Int +bar x = foolocal x + where + foolocal a = foo a ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -864,3 +864,5 @@ test('T22924', normal, compile, ['']) test('T22985a', normal, compile, ['-O']) test('T22985b', normal, compile, ['']) test('T23018', normal, compile, ['']) +test('T21909', normal, compile, ['']) +test('T21909b', normal, compile, ['']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5c3ae02d74d94d3183f288fb70a076babf338b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5c3ae02d74d94d3183f288fb70a076babf338b2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 01:30:02 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 24 Mar 2023 21:30:02 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 2 commits: expansion of a bind statement may not be as easy as it looks. T18324b.hs is a... Message-ID: <641e4e9a4f1ce_13561acc4d504185553@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: c910643b by Apoorv Ingle at 2023-03-24T18:38:41-05:00 expansion of a bind statement may not be as easy as it looks. T18324b.hs is a an example. I think its some delicate interaction between quick look and type families - - - - - 48266ae1 by Apoorv Ingle at 2023-03-24T20:29:08-05:00 do not add explicit return for `mfix` mdo blocks. This whole last stmt business is very messy. - - - - - 5 changed files: - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Module.hs - testsuite/tests/rebindable/T18324.hs - + testsuite/tests/rebindable/T18324b.hs Changes: ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -345,11 +345,11 @@ subordinates env instMap decl = case decl of InstD _ (ClsInstD _ d) -> let data_fams = do DataFamInstDecl { dfid_eqn = - FamEqn { feqn_tycon = L l _ - , feqn_rhs = defn }} <- unLoc <$> cid_datafam_insts d + (FamEqn { feqn_tycon = L l _ + , feqn_rhs = defn } :: FamEqn GhcRn (HsDataDefn GhcRn))} <- unLoc <$> cid_datafam_insts d [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] ++ dataSubs defn ty_fams = do - TyFamInstDecl { tfid_eqn = FamEqn { feqn_tycon = L l _ } } <- unLoc <$> cid_tyfam_insts d + TyFamInstDecl { tfid_eqn = (FamEqn { feqn_tycon = L l _ } :: FamEqn GhcRn (LHsType GhcRn)) } <- unLoc <$> cid_tyfam_insts d [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] in data_fams ++ ty_fams ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1203,6 +1203,8 @@ checkArgCounts matchContext (MG { mg_alts = L _ (match1:matches) }) -- ANI Questions: 1. What should be the location information in the expanded expression? Currently the error is displayed on the expanded expr and not on the unexpanded expr expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) +expand_do_stmts _ [] = pprPanic "expand_do_stmts: impossible happened. Empty stmts" empty + expand_do_stmts do_flavour [L _ (LastStmt _ body _ ret_expr)] -- last statement of a list comprehension, needs to explicitly return it -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` @@ -1226,7 +1228,7 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) -- the pattern binding x can fail -- stmts ~~> stmt' let f pat = stmts'; f _ = fail ".." -- ------------------------------------------------------- --- pat <- e ; stmts ~~> (Prelude.>>=) e f +-- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op return $ noLocA (foldl genHsApp bind_op -- (>>=) @@ -1235,7 +1237,11 @@ expand_do_stmts do_or_lc ((L _ (BindStmt xbsrn pat e)): lstmts) ]) | otherwise = -- just use the polymorhpic bindop. TODO: Necessary? - do expand_stmts <- expand_do_stmts do_or_lc lstmts +-- stmts ~~> stmts' +-- ------------------------------------------------------- +-- pat <- e ; stmts ~~> (Prelude.>>=) e (\ pat -> stmts') + do traceTc "expand_do_stmts: generic binop" empty + expand_stmts <- expand_do_stmts do_or_lc lstmts return $ noLocA (genHsApps bindMName -- (Prelude.>>=) [ e , mkHsLam [pat] expand_stmts -- (\ x -> stmts') @@ -1290,46 +1296,42 @@ expand_do_stmts do_or_lc return_stmt :: ExprLStmt GhcRn return_stmt = noLocA $ LastStmt noExtField - (mkHsApp (noLocA return_fun) - $ mkBigLHsTup (map nlHsVar all_ids) noExtField) + (-- mkHsApp (noLocA return_fun) + -- $ + mkBigLHsTup (map nlHsVar all_ids) noExtField) Nothing (SyntaxExprRn return_fun) do_stmts :: XRec GhcRn [ExprLStmt GhcRn] do_stmts = noLocA $ (unLoc rec_stmts) ++ [return_stmt] do_block :: LHsExpr GhcRn - do_block = noLocA $ HsDo noExtField (DoExpr Nothing) $ do_stmts + do_block = noLocA $ HsDo noExtField (MDoExpr Nothing) $ do_stmts mfix_expr :: LHsExpr GhcRn mfix_expr = mkHsLam [ mkBigLHsVarPatTup all_ids ] $ do_block -expand_do_stmts do_or_lc (stmt@(L _ (ApplicativeStmt _ args mb_join)): lstmts) = +expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = -- See Note [Applicative BodyStmt] -- -- stmts ~~> stmts' --- ------------------------------------------------- --- ; stmts ~~> (\ x -> stmts') <$> e1 <*> e2 ... +-- ------------------------------------------------------------------------- +-- [(<$>, e1), (<*>, e2)] ; stmts ~~> (\ x -> stmts') <$> e1 <*> e2 ... -- -- Very similar to HsToCore.Expr.dsDo -- args are [(<$>, e1), (<*>, e2), .., ] --- mb_join is Maybe (join) do { expr' <- expand_do_stmts do_or_lc lstmts + -- extracts pats and arg bodies (rhss) from args ; (pats_can_fail, rhss) <- unzip <$> mapM (do_arg . snd) args - ; body <- foldrM match_args expr' pats_can_fail -- add blocks for failable patterns + -- add blocks for failable patterns + ; body_with_fails <- foldrM match_args expr' pats_can_fail - ; let expand_ado_expr = foldl mk_app_call body (zip (map fst args) rhss) - ; traceTc "expand_do_stmts: debug" $ (vcat [ text "stmt:" <+> ppr stmt - , text "(pats,rhss):" <+> ppr (pats_can_fail, rhss) - , text "expr':" <+> ppr expr' - , text "args" <+> ppr args - , text "final_ado" <+> ppr expand_ado_expr - ]) + -- builds (body <$> e1 <*> e2 ...) + ; let expand_ado_expr = foldl mk_apps body_with_fails (zip (map fst args) rhss) - - -- pprPanic "expand_do_stmts: impossible happened ApplicativeStmt" empty + -- wrap the expanded expression with a `join` if needed ; case mb_join of Nothing -> return expand_ado_expr - Just NoSyntaxExprRn -> return expand_ado_expr -- this is stupid + Just NoSyntaxExprRn -> return expand_ado_expr -- why can this happen? Just (SyntaxExprRn join_op) -> return $ mkHsApp (noLocA join_op) expand_ado_expr } where @@ -1343,18 +1345,18 @@ expand_do_stmts do_or_lc (stmt@(L _ (ApplicativeStmt _ args mb_join)): lstmts) = match_args :: (LPat GhcRn, FailOperator GhcRn) -> LHsExpr GhcRn -> TcM (LHsExpr GhcRn) match_args (pat, fail_op) body = mk_failable_lexpr_tcm pat body fail_op - mk_app_call l (op, r) = case op of - SyntaxExprRn op -> mkHsApps (noLocA op) [l, r] - NoSyntaxExprRn -> pprPanic "expand_do_stmts: impossible happened first arg" (ppr op) + mk_apps l (op, r) = + case op of + SyntaxExprRn op -> mkHsApps (noLocA op) [l, r] + NoSyntaxExprRn -> pprPanic "expand_do_stmts op:" (ppr op) expand_do_stmts _ (stmt@(L _ (TransStmt {})):_) = - pprPanic "expand_do_stmts: impossible happened TransStmt" $ ppr stmt + pprPanic "expand_do_stmts: TransStmt" $ ppr stmt expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = -- See See Note [Monad Comprehensions] - pprPanic "expand_do_stmts: impossible happened ParStmt" $ ppr stmt - + pprPanic "expand_do_stmts: ParStmt" $ ppr stmt expand_do_stmts do_flavor stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr do_flavor $$ ppr stmts) ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -701,7 +701,7 @@ tcRnHsBootDecls hsc_src decls , hs_defds = def_decls , hs_ruleds = rule_decls , hs_annds = _ - , hs_valds = XValBindsLR (NValBinds val_binds val_sigs) }) + , hs_valds = (XValBindsLR (NValBinds val_binds val_sigs) :: HsValBinds GhcRn ) }) <- rnTopSrcDecls first_group -- The empty list is for extra dependencies coming from .hs-boot files @@ -1485,7 +1485,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, -- and import the supporting declarations traceTc "Tc3" empty ; (tcg_env, inst_infos, th_bndrs, - XValBindsLR (NValBinds deriv_binds deriv_sigs)) + (XValBindsLR (NValBinds deriv_binds deriv_sigs) :: HsValBinds GhcRn)) <- tcTyClsInstDecls tycl_decls deriv_decls val_binds ; updLclEnv (\tcl_env -> tcl_env { tcl_th_bndrs = th_bndrs `plusNameEnv` tcl_th_bndrs tcl_env }) $ ===================================== testsuite/tests/rebindable/T18324.hs ===================================== @@ -2,7 +2,6 @@ -- {-# LANGUAGE MonadComprehensions, RecursiveDo #-} module Main where - type Id = forall a. a -> a t :: IO Id @@ -15,13 +14,6 @@ foo1 = t >>= \x -> return (p x) foo2 = do { x <- t ; return (p x) } - -main = do x <- foo2 +main = do x <- foo1 putStrLn $ show x - -data D a b = D b b | E a a - -fffgg daa = case daa of - D b1 b2 -> let - x = do ===================================== testsuite/tests/rebindable/T18324b.hs ===================================== @@ -0,0 +1,88 @@ +{-# LANGUAGE GADTs, TypeFamilies, TypeFamilyDependencies #-} +{-# LANGUAGE AllowAmbiguousTypes #-} -- for unXRec, etc. +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE EmptyDataDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE UndecidableInstances #-} + +module T18324b where + + +data L a e = L a e +unLoc :: L a e -> e +unLoc (L _ e) = e + +data B = B + + +type family XRec p a = r | r -> a +type instance XRec (GhcPass p) a = L (Anno a) a + +type family Anno a = b + +data GhcPass (pass :: Pass) +data Pass = Rn + +type family IdGhcP (pass :: Pass) where + IdGhcP 'Rn = B + + +type GhcRn = GhcPass 'Rn + +data LHsType pass + +data ClsInstDecl pass = + ClsInstDecl + { -- cid_tyfam_insts :: [LTyFamInstDecl pass] + -- , + cid_datafam_insts :: [LDataFamInstDecl pass] + } + + +-- type LTyFamInstDecl pass = XRec pass (TyFamInstDecl pass) +type LDataFamInstDecl pass = XRec pass ([FamEqn pass (HsDataDefn pass)]) +-- type TyFamDefltDecl = TyFamInstDecl + +type family IdP p +type instance IdP (GhcPass p) = IdGhcP p + +type LIdP p = XRec p (IdP p) + +data HsDataDefn pass + +data FamEqn pass rhs + = FamEqn + { feqn_tycon :: LIdP pass + +-- LIdP (GhcRn) ~~> + + , feqn_rhs :: rhs } + +-- type TyFamInstEqn pass = FamEqn pass (LHsType pass) + +-- data TyFamInstDecl pass +-- = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass } + + +fffggg :: ClsInstDecl GhcRn -> [Int] +fffggg ddd = -- let + -- data_fams = + do + [FamEqn { feqn_tycon = L l _ + , feqn_rhs = defn }] <- unLoc <$> cid_datafam_insts ddd + [ 0 ] + -- in + -- data_fams + -- ty_fams = do + -- TyFamInstDecl { tfid_eqn = FamEqn { feqn_tycon = L l _ } } <- unLoc <$> cid_tyfam_insts ddd + -- [ 0 ] + -- in data_fams ++ ty_fams View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a0f732508aa4fd0fc23a6f9e51052b0413318154...48266ae1b014e3bf62ef1f9a54228dc682d500d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a0f732508aa4fd0fc23a6f9e51052b0413318154...48266ae1b014e3bf62ef1f9a54228dc682d500d3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 04:03:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 25 Mar 2023 00:03:00 -0400 Subject: [Git][ghc/ghc][master] base: Document GHC versions associated with past base versions in the changelog Message-ID: <641e7274d4695_13561af4831e020297c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 1 changed file: - libraries/base/changelog.md Changes: ===================================== libraries/base/changelog.md ===================================== @@ -16,10 +16,11 @@ ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) ## 4.18.0.0 *TBA* - + * Shipped with GHC 9.6.1 * `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified pointer types in foreign declarations when using `CApiFFI` extension. ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) * Add `forall a. Functor (p a)` superclass for `Bifunctor p` ([CLC proposal #91](https://github.com/haskell/core-libraries-committee/issues/91)) + * Add `forall a. Functor (p a)` superclass for `Bifunctor p`. * Add Functor instances for `(,,,,) a b c d`, `(,,,,,) a b c d e` and `(,,,,,) a b c d e f`. * Exceptions thrown by weak pointer finalizers can now be reported by setting @@ -91,6 +92,8 @@ ## 4.17.0.0 *August 2022* + * Shipped with GHC 9.4.1 + * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. * Add `Generically` and `Generically1` to `GHC.Generics` for deriving generic @@ -200,6 +203,8 @@ ## 4.16.0.0 *Nov 2021* + * Shipped with GHC 9.2.1 + * The unary tuple type, `Solo`, is now exported by `Data.Tuple`. * Add a `Typeable` constraint to `fromStaticPtr` in the class `GHC.StaticPtr.IsStatic`. @@ -260,6 +265,8 @@ ## 4.15.0.0 *Feb 2021* + * Shipped with GHC 9.0.1 + * `openFile` now calls the `open` system call with an `interruptible` FFI call, ensuring that the call can be interrupted with `SIGINT` on POSIX systems. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a73655fd6d22f0fd7e1c24d0d07a573b6bdc042 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a73655fd6d22f0fd7e1c24d0d07a573b6bdc042 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 04:03:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 25 Mar 2023 00:03:43 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Add regression test for #17574 Message-ID: <641e729f3beeb_13561af4830f020647d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 8 changed files: - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/Storage.c - + testsuite/tests/rts/T17574.hs - + testsuite/tests/rts/T17574.stdout - testsuite/tests/rts/all.T Changes: ===================================== rts/sm/NonMoving.c ===================================== @@ -395,7 +395,8 @@ Mutex concurrent_coll_finished_lock; * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * The nonmoving collector uses an approximate heuristic for reporting live * data quantity. Specifically, during mark we record how much live data we - * find in nonmoving_live_words. At the end of mark we declare this amount to + * find in nonmoving_segment_live_words. At the end of mark this is combined with nonmoving_large_words + * and nonmoving_compact_words, and we declare this amount to * be how much live data we have on in the nonmoving heap (by setting * oldest_gen->live_estimate). * @@ -540,7 +541,7 @@ Mutex concurrent_coll_finished_lock; * */ -memcount nonmoving_live_words = 0; +memcount nonmoving_segment_live_words = 0; // See Note [Sync phase marking budget]. MarkBudget sync_phase_marking_budget = 200000; @@ -682,10 +683,11 @@ static void nonmovingPrepareMark(void) dbl_link_onto(bd, &nonmoving_large_objects); } n_nonmoving_large_blocks += oldest_gen->n_large_blocks; + nonmoving_large_words += oldest_gen->n_large_words; oldest_gen->large_objects = NULL; oldest_gen->n_large_words = 0; oldest_gen->n_large_blocks = 0; - nonmoving_live_words = 0; + nonmoving_segment_live_words = 0; // Clear compact object mark bits for (bdescr *bd = nonmoving_compact_objects; bd; bd = bd->link) { @@ -700,6 +702,7 @@ static void nonmovingPrepareMark(void) dbl_link_onto(bd, &nonmoving_compact_objects); } n_nonmoving_compact_blocks += oldest_gen->n_compact_blocks; + nonmoving_compact_words += oldest_gen->n_compact_blocks * BLOCK_SIZE_W; oldest_gen->n_compact_blocks = 0; oldest_gen->compact_objects = NULL; // TODO (osa): what about "in import" stuff?? @@ -1053,7 +1056,9 @@ concurrent_marking: freeMarkQueue(mark_queue); stgFree(mark_queue); - oldest_gen->live_estimate = nonmoving_live_words; + nonmoving_large_words = countOccupied(nonmoving_marked_large_objects); + nonmoving_compact_words = n_nonmoving_marked_compact_blocks * BLOCK_SIZE_W; + oldest_gen->live_estimate = nonmoving_segment_live_words + nonmoving_large_words + nonmoving_compact_words; oldest_gen->n_old_blocks = 0; resizeGenerations(); ===================================== rts/sm/NonMoving.h ===================================== @@ -122,7 +122,7 @@ struct NonmovingHeap { extern struct NonmovingHeap nonmovingHeap; -extern memcount nonmoving_live_words; +extern memcount nonmoving_segment_live_words; #if defined(THREADED_RTS) extern bool concurrent_coll_running; ===================================== rts/sm/NonMovingMark.c ===================================== @@ -76,6 +76,10 @@ static bool is_nonmoving_weak(StgWeak *weak); * consequently will trace the pointers of only one object per block. However, * this is okay since the only type of pinned object supported by GHC is the * pinned ByteArray#, which has no pointers. + * + * We need to take care that the stats department is made aware of the amount of + * live large (and compact) objects, since they no longer live on gen[i]->large_objects. + * Failing to do so caused #17574. */ bdescr *nonmoving_large_objects = NULL; @@ -83,6 +87,9 @@ bdescr *nonmoving_marked_large_objects = NULL; memcount n_nonmoving_large_blocks = 0; memcount n_nonmoving_marked_large_blocks = 0; +memcount nonmoving_large_words = 0; +memcount nonmoving_compact_words = 0; + bdescr *nonmoving_compact_objects = NULL; bdescr *nonmoving_marked_compact_objects = NULL; memcount n_nonmoving_compact_blocks = 0; @@ -1745,7 +1752,7 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) struct NonmovingSegment *seg = nonmovingGetSegment((StgPtr) p); nonmoving_block_idx block_idx = nonmovingGetBlockIdx((StgPtr) p); nonmovingSetMark(seg, block_idx); - nonmoving_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_); + nonmoving_segment_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_); } // If we found a indirection to shortcut keep going. ===================================== rts/sm/NonMovingMark.h ===================================== @@ -127,6 +127,11 @@ extern bdescr *nonmoving_large_objects, *nonmoving_marked_large_objects, extern memcount n_nonmoving_large_blocks, n_nonmoving_marked_large_blocks, n_nonmoving_compact_blocks, n_nonmoving_marked_compact_blocks; +// The size of live large/compact objects in words. +// Only updated at the end of nonmoving GC. +extern memcount nonmoving_large_words, + nonmoving_compact_words; + extern StgTSO *nonmoving_old_threads; extern StgWeak *nonmoving_old_weak_ptr_list; extern StgTSO *nonmoving_threads; ===================================== rts/sm/Storage.c ===================================== @@ -42,6 +42,7 @@ #include "GC.h" #include "Evac.h" #include "NonMovingAllocate.h" +#include "sm/NonMovingMark.h" #if defined(ios_HOST_OS) || defined(darwin_HOST_OS) #include "Hash.h" #endif @@ -1615,7 +1616,12 @@ W_ genLiveWords (generation *gen) W_ genLiveBlocks (generation *gen) { - return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks; + W_ nonmoving_blocks = 0; + // The nonmoving heap contains some blocks that live outside the regular generation structure. + if (gen == oldest_gen && RtsFlags.GcFlags.useNonmoving){ + nonmoving_blocks = n_nonmoving_large_blocks + n_nonmoving_marked_large_blocks + n_nonmoving_compact_blocks + n_nonmoving_marked_compact_blocks; + } + return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks + nonmoving_blocks; } W_ gcThreadLiveWords (uint32_t i, uint32_t g) @@ -1711,6 +1717,9 @@ StgWord calcTotalLargeObjectsW (void) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { totalW += generations[g].n_large_words; } + + totalW += nonmoving_large_words; + return totalW; } @@ -1722,6 +1731,9 @@ StgWord calcTotalCompactW (void) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { totalW += generations[g].n_compact_blocks * BLOCK_SIZE_W; } + + totalW += nonmoving_compact_words; + return totalW; } ===================================== testsuite/tests/rts/T17574.hs ===================================== @@ -0,0 +1,40 @@ +-- | Check that large objects are properly accounted for by GHC.Stats +module Main (main) where + +import Control.Monad +import Control.Exception +import Control.Concurrent +import System.Mem +import System.Exit +import GHC.Stats +import GHC.Compact +import Data.List (replicate) + +import qualified Data.ByteString.Char8 as BS + +doGC :: IO () +doGC = do + performMajorGC + threadDelay 1000 -- small delay to allow GC to run when using concurrent gc + +main :: IO () +main = do + let size = 4096*2 + largeString <- evaluate $ BS.replicate size 'A' + compactString <- compact $ replicate size 'A' + doGC + doGC -- run GC twice to make sure the objects end up in the oldest gen + stats <- getRTSStats + let large_obj_bytes = gcdetails_large_objects_bytes $ gc stats + let compact_obj_bytes = gcdetails_compact_bytes $ gc stats + -- assert that large_obj_bytes is at least as big as size + -- this indicates that `largeString` is being accounted for by the stats department + when (large_obj_bytes < fromIntegral size) $ do + putStrLn $ "large_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size + exitFailure + when (compact_obj_bytes < fromIntegral size) $ do + putStrLn $ "compact_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size + exitFailure + -- keep them alive + print $ BS.length largeString + print $ length $ getCompact compactString ===================================== testsuite/tests/rts/T17574.stdout ===================================== @@ -0,0 +1,2 @@ +8192 +8192 ===================================== testsuite/tests/rts/all.T ===================================== @@ -573,3 +573,5 @@ test('decodeMyStack_emptyListForMissingFlag', test('T22795a', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded']) test('T22795b', [only_ways(['normal']), js_skip], compile_and_run, ['-single-threaded']) test('T22795c', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded -single-threaded']) + +test('T17574', [js_skip], compile_and_run, ['-with-rtsopts -T']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6a73655fd6d22f0fd7e1c24d0d07a573b6bdc042...f2d56bf735185a59d7ce916edcf6a97f1401b230 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6a73655fd6d22f0fd7e1c24d0d07a573b6bdc042...f2d56bf735185a59d7ce916edcf6a97f1401b230 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 04:04:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 25 Mar 2023 00:04:21 -0400 Subject: [Git][ghc/ghc][master] Modify ThreadId documentation and comments Message-ID: <641e72c5407d3_13561af4831e0210153@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - 1 changed file: - libraries/base/GHC/Conc/Sync.hs Changes: ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -133,9 +133,6 @@ infixr 0 `par`, `pseq` ----------------------------------------------------------------------------- data ThreadId = ThreadId ThreadId# --- ToDo: data ThreadId = ThreadId (Weak ThreadId#) --- But since ThreadId# is unlifted, the Weak type must use open --- type variables. {- ^ A 'ThreadId' is an abstract type representing a handle to a thread. 'ThreadId' is an instance of 'Eq', 'Ord' and 'Show', where @@ -146,10 +143,9 @@ useful when debugging or diagnosing the behaviour of a concurrent program. /Note/: in GHC, if you have a 'ThreadId', you essentially have -a pointer to the thread itself. This means the thread itself can\'t be -garbage collected until you drop the 'ThreadId'. -This misfeature will hopefully be corrected at a later date. - +a pointer to the thread itself. This means the thread itself can\'t be +garbage collected until you drop the 'ThreadId'. This misfeature would +be difficult to correct while continuing to support 'threadStatus'. -} -- | @since 4.2.0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7131b705d54ed7ed20e9946d9ace45228ec5febd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7131b705d54ed7ed20e9946d9ace45228ec5febd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 04:05:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 25 Mar 2023 00:05:00 -0400 Subject: [Git][ghc/ghc][master] rts: Fix barriers of IND and IND_STATIC Message-ID: <641e72ecb89be_13561af85b86c2155cd@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 2 changed files: - rts/StgMiscClosures.cmm - rts/include/stg/SMP.h Changes: ===================================== rts/StgMiscClosures.cmm ===================================== @@ -521,6 +521,7 @@ INFO_TABLE(stg_IND,1,0,IND,"IND","IND") (P_ node) { TICK_ENT_DYN_IND(); /* tick */ + ACQUIRE_FENCE; node = UNTAG(StgInd_indirectee(node)); TICK_ENT_VIA_NODE(); jump %GET_ENTRY(node) (node); @@ -529,6 +530,7 @@ INFO_TABLE(stg_IND,1,0,IND,"IND","IND") /* explicit stack */ { TICK_ENT_DYN_IND(); /* tick */ + ACQUIRE_FENCE; R1 = UNTAG(StgInd_indirectee(R1)); TICK_ENT_VIA_NODE(); jump %GET_ENTRY(R1) [R1]; @@ -539,6 +541,7 @@ INFO_TABLE(stg_IND_STATIC,1,0,IND_STATIC,"IND_STATIC","IND_STATIC") /* explicit stack */ { TICK_ENT_STATIC_IND(); /* tick */ + ACQUIRE_FENCE; R1 = UNTAG(StgInd_indirectee(R1)); TICK_ENT_VIA_NODE(); jump %GET_ENTRY(R1) [R1]; ===================================== rts/include/stg/SMP.h ===================================== @@ -214,23 +214,22 @@ EXTERN_INLINE void load_load_barrier(void); * examining a thunk being updated can see the indirectee. Consequently, a * thunk update (see rts/Updates.h) does the following: * - * 1. Use a release-fence to ensure that the indirectee is visible - * 2. Use a relaxed-store to place the new indirectee into the thunk's + * 1. Use a relaxed-store to place the new indirectee into the thunk's * indirectee field - * 3. use a release-store to set the info table to stg_BLACKHOLE (which + * 2. use a release-store to set the info table to stg_BLACKHOLE (which * represents an indirection) * * Blackholing a thunk (either eagerly, by GHC.StgToCmm.Bind.emitBlackHoleCode, * or lazily, by ThreadPaused.c:threadPaused) is done similarly. * - * Conversely, thunk entry (see the entry code of stg_BLACKHOLE in - * rts/StgMiscClosure) does the following: + * Conversely, indirection entry (see the entry code of stg_BLACKHOLE, stg_IND, + * and stg_IND_STATIC in rts/StgMiscClosure.cmm) does the following: * - * 1. We jump into the entry code for stg_BLACKHOLE; this of course implies - * that we have already read the thunk's info table pointer, which is done - * with a relaxed load. + * 1. We jump into the entry code for, e.g., stg_BLACKHOLE; this of course + * implies that we have already read the thunk's info table pointer, which + * is done with a relaxed load. * 2. use an acquire-fence to ensure that our view on the thunk is - * up-to-date. This synchronizes with step (3) in the update + * up-to-date. This synchronizes with step (2) in the update * procedure. * 3. relaxed-load the indirectee. Since thunks are updated at most * once we know that the fence in the last step has given us View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c421bbbbf2a353858dda8f998d4997cce5977c03 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c421bbbbf2a353858dda8f998d4997cce5977c03 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 04:05:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 25 Mar 2023 00:05:37 -0400 Subject: [Git][ghc/ghc][master] Improve documentation of atomicModifyMutVar2# Message-ID: <641e7311a3bf3_13561af8b8490219265@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - 1 changed file: - compiler/GHC/Builtin/primops.txt.pp Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2528,11 +2528,23 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp primop AtomicModifyMutVar2Op "atomicModifyMutVar2#" GenPrimOp MutVar# s a -> (a -> c) -> State# s -> (# State# s, a, c #) { Modify the contents of a 'MutVar#', returning the previous - contents and the result of applying the given function to the - previous contents. Note that this isn't strictly - speaking the correct type for this function; it should really be - @'MutVar#' s a -> (a -> (a,b)) -> 'State#' s -> (# 'State#' s, a, (a, b) #)@, - but we don't know about pairs here. } + contents @x :: a@ and the result of applying the given function to the + previous contents @f x :: c at . + + The @data@ type @c@ (not a @newtype@!) must be a record whose first field + is of lifted type @a :: Type@ and is not unpacked. For example, product + types @c ~ Solo a@ or @c ~ (a, b)@ work well. If the record type is both + monomorphic and strict in its first field, it's recommended to mark the + latter @{-# NOUNPACK #-}@ explicitly. + + Under the hood 'atomicModifyMutVar2#' atomically replaces a pointer to an + old @x :: a@ with a pointer to a selector thunk @fst r@, where + @fst@ is a selector for the first field of the record and @r@ is a + function application thunk @r = f x at . + + @atomicModifyIORef2Native@ from @atomic-modify-general@ package makes an + effort to reflect restrictions on @c@ faithfully, providing a + well-typed high-level wrapper.} with out_of_line = True has_side_effects = True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62fa7faaf8ca2d34cda3e3b7c4c6b2d13efa16fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62fa7faaf8ca2d34cda3e3b7c4c6b2d13efa16fe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 04:36:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 25 Mar 2023 00:36:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: base: Document GHC versions associated with past base versions in the changelog Message-ID: <641e7a5ebcddc_13561a105456a4220911@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - 11441143 by Cheng Shao at 2023-03-25T00:36:32-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - 51f2a2c6 by Cheng Shao at 2023-03-25T00:36:32-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 6991f2b7 by Bodigrim at 2023-03-25T00:36:34-04:00 Improve documentation for resizing of byte arrays - - - - - 21 changed files: - compiler/GHC/Builtin/primops.txt.pp - libraries/base/GHC/Conc/Sync.hs - libraries/base/changelog.md - rts/HsFFI.c - rts/RtsSymbols.c - rts/StgMiscClosures.cmm - rts/include/stg/SMP.h - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/Storage.c - testsuite/.gitignore - testsuite/tests/ffi/should_run/Makefile - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ffi/should_run/ffi023_c.c - + testsuite/tests/ffi/should_run/rts_clearMemory.hs - + testsuite/tests/ffi/should_run/rts_clearMemory_c.c - + testsuite/tests/rts/T17574.hs - + testsuite/tests/rts/T17574.stdout - testsuite/tests/rts/all.T Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1567,7 +1567,16 @@ primop ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp SmallMutableArray# s v -> Int# -> State# s -> State# s {Shrink mutable array to new specified size, in the specified state thread. The new size argument must be less than or - equal to the current size as reported by 'getSizeofSmallMutableArray#'.} + equal to the current size as reported by 'getSizeofSmallMutableArray#'. + + Assuming the non-profiling RTS, for the copying garbage collector + (default) this primitive compiles to an O(1) operation in C--, modifying + the array in-place. For the non-moving garbage collector, however, the + time is proportional to the number of elements shrinked out. Backends + bypassing C-- representation (such as JavaScript) might behave + differently. + + @since 0.6.1} with out_of_line = True has_side_effects = True @@ -1591,14 +1600,17 @@ primop SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp primop SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp SmallMutableArray# s v -> Int# - {Return the number of elements in the array. Note that this is deprecated - as it is unsafe in the presence of shrink and resize operations on the - same small mutable array.} + {Return the number of elements in the array. __Deprecated__, it is + unsafe in the presence of 'shrinkSmallMutableArray#' and @resizeSmallMutableArray#@ + operations on the same small mutable array.} with deprecated_msg = { Use 'getSizeofSmallMutableArray#' instead } primop GetSizeofSmallMutableArrayOp "getSizeofSmallMutableArray#" GenPrimOp SmallMutableArray# s v -> State# s -> (# State# s, Int# #) - {Return the number of elements in the array.} + {Return the number of elements in the array, correctly accounting for + the effect of 'shrinkSmallMutableArray#' and @resizeSmallMutableArray#@. + + @since 0.6.1} primop IndexSmallArrayOp "indexSmallArray#" GenPrimOp SmallArray# v -> Int# -> (# v #) @@ -1807,13 +1819,19 @@ primop ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> State# s {Shrink mutable byte array to new specified size (in bytes), in the specified state thread. The new size argument must be less than or - equal to the current size as reported by 'getSizeofMutableByteArray#'.} + equal to the current size as reported by 'getSizeofMutableByteArray#'. + + Assuming the non-profiling RTS, this primitive compiles to an O(1) + operation in C--, modifying the array in-place. Backends bypassing C-- + representation (such as JavaScript) might behave differently. + + @since 0.4.0.0} with out_of_line = True has_side_effects = True primop ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #) - {Resize (unpinned) mutable byte array to new specified size (in bytes). + {Resize mutable byte array to new specified size (in bytes), shrinking or growing it. The returned 'MutableByteArray#' is either the original 'MutableByteArray#' resized in-place or, if not possible, a newly allocated (unpinned) 'MutableByteArray#' (with the original content @@ -1823,7 +1841,9 @@ primop ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp not be accessed anymore after a 'resizeMutableByteArray#' has been performed. Moreover, no reference to the old one should be kept in order to allow garbage collection of the original 'MutableByteArray#' in - case a new 'MutableByteArray#' had to be allocated.} + case a new 'MutableByteArray#' had to be allocated. + + @since 0.4.0.0} with out_of_line = True has_side_effects = True @@ -1839,14 +1859,18 @@ primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# - {Return the size of the array in bytes. Note that this is deprecated as it is - unsafe in the presence of shrink and resize operations on the same mutable byte + {Return the size of the array in bytes. __Deprecated__, it is + unsafe in the presence of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#' + operations on the same mutable byte array.} with deprecated_msg = { Use 'getSizeofMutableByteArray#' instead } primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp MutableByteArray# s -> State# s -> (# State# s, Int# #) - {Return the number of elements in the array.} + {Return the number of elements in the array, correctly accounting for + the effect of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#'. + + @since 0.5.0.0} #include "bytearray-ops.txt.pp" @@ -2528,11 +2552,23 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp primop AtomicModifyMutVar2Op "atomicModifyMutVar2#" GenPrimOp MutVar# s a -> (a -> c) -> State# s -> (# State# s, a, c #) { Modify the contents of a 'MutVar#', returning the previous - contents and the result of applying the given function to the - previous contents. Note that this isn't strictly - speaking the correct type for this function; it should really be - @'MutVar#' s a -> (a -> (a,b)) -> 'State#' s -> (# 'State#' s, a, (a, b) #)@, - but we don't know about pairs here. } + contents @x :: a@ and the result of applying the given function to the + previous contents @f x :: c at . + + The @data@ type @c@ (not a @newtype@!) must be a record whose first field + is of lifted type @a :: Type@ and is not unpacked. For example, product + types @c ~ Solo a@ or @c ~ (a, b)@ work well. If the record type is both + monomorphic and strict in its first field, it's recommended to mark the + latter @{-# NOUNPACK #-}@ explicitly. + + Under the hood 'atomicModifyMutVar2#' atomically replaces a pointer to an + old @x :: a@ with a pointer to a selector thunk @fst r@, where + @fst@ is a selector for the first field of the record and @r@ is a + function application thunk @r = f x at . + + @atomicModifyIORef2Native@ from @atomic-modify-general@ package makes an + effort to reflect restrictions on @c@ faithfully, providing a + well-typed high-level wrapper.} with out_of_line = True has_side_effects = True ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -133,9 +133,6 @@ infixr 0 `par`, `pseq` ----------------------------------------------------------------------------- data ThreadId = ThreadId ThreadId# --- ToDo: data ThreadId = ThreadId (Weak ThreadId#) --- But since ThreadId# is unlifted, the Weak type must use open --- type variables. {- ^ A 'ThreadId' is an abstract type representing a handle to a thread. 'ThreadId' is an instance of 'Eq', 'Ord' and 'Show', where @@ -146,10 +143,9 @@ useful when debugging or diagnosing the behaviour of a concurrent program. /Note/: in GHC, if you have a 'ThreadId', you essentially have -a pointer to the thread itself. This means the thread itself can\'t be -garbage collected until you drop the 'ThreadId'. -This misfeature will hopefully be corrected at a later date. - +a pointer to the thread itself. This means the thread itself can\'t be +garbage collected until you drop the 'ThreadId'. This misfeature would +be difficult to correct while continuing to support 'threadStatus'. -} -- | @since 4.2.0.0 ===================================== libraries/base/changelog.md ===================================== @@ -16,10 +16,11 @@ ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) ## 4.18.0.0 *TBA* - + * Shipped with GHC 9.6.1 * `Foreign.C.ConstPtr.ConstrPtr` was added to encode `const`-qualified pointer types in foreign declarations when using `CApiFFI` extension. ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117)) * Add `forall a. Functor (p a)` superclass for `Bifunctor p` ([CLC proposal #91](https://github.com/haskell/core-libraries-committee/issues/91)) + * Add `forall a. Functor (p a)` superclass for `Bifunctor p`. * Add Functor instances for `(,,,,) a b c d`, `(,,,,,) a b c d e` and `(,,,,,) a b c d e f`. * Exceptions thrown by weak pointer finalizers can now be reported by setting @@ -91,6 +92,8 @@ ## 4.17.0.0 *August 2022* + * Shipped with GHC 9.4.1 + * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. * Add `Generically` and `Generically1` to `GHC.Generics` for deriving generic @@ -200,6 +203,8 @@ ## 4.16.0.0 *Nov 2021* + * Shipped with GHC 9.2.1 + * The unary tuple type, `Solo`, is now exported by `Data.Tuple`. * Add a `Typeable` constraint to `fromStaticPtr` in the class `GHC.StaticPtr.IsStatic`. @@ -260,6 +265,8 @@ ## 4.15.0.0 *Feb 2021* + * Shipped with GHC 9.0.1 + * `openFile` now calls the `open` system call with an `interruptible` FFI call, ensuring that the call can be interrupted with `SIGINT` on POSIX systems. ===================================== rts/HsFFI.c ===================================== @@ -24,8 +24,8 @@ hs_set_argv(int argc, char *argv[]) void hs_perform_gc(void) { - /* Hmmm, the FFI spec is a bit vague, but it seems to imply a major GC... */ - performMajorGC(); + /* Hmmm, the FFI spec is a bit vague, but it seems to imply a blocking major GC... */ + performBlockingMajorGC(); } // Lock the stable pointer table ===================================== rts/RtsSymbols.c ===================================== @@ -649,6 +649,7 @@ extern char **environ; SymI_HasProto(updateRemembSetPushClosure_) \ SymI_HasProto(performGC) \ SymI_HasProto(performMajorGC) \ + SymI_HasProto(performBlockingMajorGC) \ SymI_HasProto(prog_argc) \ SymI_HasProto(prog_argv) \ SymI_HasDataProto(stg_putMVarzh) \ ===================================== rts/StgMiscClosures.cmm ===================================== @@ -521,6 +521,7 @@ INFO_TABLE(stg_IND,1,0,IND,"IND","IND") (P_ node) { TICK_ENT_DYN_IND(); /* tick */ + ACQUIRE_FENCE; node = UNTAG(StgInd_indirectee(node)); TICK_ENT_VIA_NODE(); jump %GET_ENTRY(node) (node); @@ -529,6 +530,7 @@ INFO_TABLE(stg_IND,1,0,IND,"IND","IND") /* explicit stack */ { TICK_ENT_DYN_IND(); /* tick */ + ACQUIRE_FENCE; R1 = UNTAG(StgInd_indirectee(R1)); TICK_ENT_VIA_NODE(); jump %GET_ENTRY(R1) [R1]; @@ -539,6 +541,7 @@ INFO_TABLE(stg_IND_STATIC,1,0,IND_STATIC,"IND_STATIC","IND_STATIC") /* explicit stack */ { TICK_ENT_STATIC_IND(); /* tick */ + ACQUIRE_FENCE; R1 = UNTAG(StgInd_indirectee(R1)); TICK_ENT_VIA_NODE(); jump %GET_ENTRY(R1) [R1]; ===================================== rts/include/stg/SMP.h ===================================== @@ -214,23 +214,22 @@ EXTERN_INLINE void load_load_barrier(void); * examining a thunk being updated can see the indirectee. Consequently, a * thunk update (see rts/Updates.h) does the following: * - * 1. Use a release-fence to ensure that the indirectee is visible - * 2. Use a relaxed-store to place the new indirectee into the thunk's + * 1. Use a relaxed-store to place the new indirectee into the thunk's * indirectee field - * 3. use a release-store to set the info table to stg_BLACKHOLE (which + * 2. use a release-store to set the info table to stg_BLACKHOLE (which * represents an indirection) * * Blackholing a thunk (either eagerly, by GHC.StgToCmm.Bind.emitBlackHoleCode, * or lazily, by ThreadPaused.c:threadPaused) is done similarly. * - * Conversely, thunk entry (see the entry code of stg_BLACKHOLE in - * rts/StgMiscClosure) does the following: + * Conversely, indirection entry (see the entry code of stg_BLACKHOLE, stg_IND, + * and stg_IND_STATIC in rts/StgMiscClosure.cmm) does the following: * - * 1. We jump into the entry code for stg_BLACKHOLE; this of course implies - * that we have already read the thunk's info table pointer, which is done - * with a relaxed load. + * 1. We jump into the entry code for, e.g., stg_BLACKHOLE; this of course + * implies that we have already read the thunk's info table pointer, which + * is done with a relaxed load. * 2. use an acquire-fence to ensure that our view on the thunk is - * up-to-date. This synchronizes with step (3) in the update + * up-to-date. This synchronizes with step (2) in the update * procedure. * 3. relaxed-load the indirectee. Since thunks are updated at most * once we know that the fence in the last step has given us ===================================== rts/sm/NonMoving.c ===================================== @@ -395,7 +395,8 @@ Mutex concurrent_coll_finished_lock; * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * The nonmoving collector uses an approximate heuristic for reporting live * data quantity. Specifically, during mark we record how much live data we - * find in nonmoving_live_words. At the end of mark we declare this amount to + * find in nonmoving_segment_live_words. At the end of mark this is combined with nonmoving_large_words + * and nonmoving_compact_words, and we declare this amount to * be how much live data we have on in the nonmoving heap (by setting * oldest_gen->live_estimate). * @@ -540,7 +541,7 @@ Mutex concurrent_coll_finished_lock; * */ -memcount nonmoving_live_words = 0; +memcount nonmoving_segment_live_words = 0; // See Note [Sync phase marking budget]. MarkBudget sync_phase_marking_budget = 200000; @@ -682,10 +683,11 @@ static void nonmovingPrepareMark(void) dbl_link_onto(bd, &nonmoving_large_objects); } n_nonmoving_large_blocks += oldest_gen->n_large_blocks; + nonmoving_large_words += oldest_gen->n_large_words; oldest_gen->large_objects = NULL; oldest_gen->n_large_words = 0; oldest_gen->n_large_blocks = 0; - nonmoving_live_words = 0; + nonmoving_segment_live_words = 0; // Clear compact object mark bits for (bdescr *bd = nonmoving_compact_objects; bd; bd = bd->link) { @@ -700,6 +702,7 @@ static void nonmovingPrepareMark(void) dbl_link_onto(bd, &nonmoving_compact_objects); } n_nonmoving_compact_blocks += oldest_gen->n_compact_blocks; + nonmoving_compact_words += oldest_gen->n_compact_blocks * BLOCK_SIZE_W; oldest_gen->n_compact_blocks = 0; oldest_gen->compact_objects = NULL; // TODO (osa): what about "in import" stuff?? @@ -1053,7 +1056,9 @@ concurrent_marking: freeMarkQueue(mark_queue); stgFree(mark_queue); - oldest_gen->live_estimate = nonmoving_live_words; + nonmoving_large_words = countOccupied(nonmoving_marked_large_objects); + nonmoving_compact_words = n_nonmoving_marked_compact_blocks * BLOCK_SIZE_W; + oldest_gen->live_estimate = nonmoving_segment_live_words + nonmoving_large_words + nonmoving_compact_words; oldest_gen->n_old_blocks = 0; resizeGenerations(); ===================================== rts/sm/NonMoving.h ===================================== @@ -122,7 +122,7 @@ struct NonmovingHeap { extern struct NonmovingHeap nonmovingHeap; -extern memcount nonmoving_live_words; +extern memcount nonmoving_segment_live_words; #if defined(THREADED_RTS) extern bool concurrent_coll_running; ===================================== rts/sm/NonMovingMark.c ===================================== @@ -76,6 +76,10 @@ static bool is_nonmoving_weak(StgWeak *weak); * consequently will trace the pointers of only one object per block. However, * this is okay since the only type of pinned object supported by GHC is the * pinned ByteArray#, which has no pointers. + * + * We need to take care that the stats department is made aware of the amount of + * live large (and compact) objects, since they no longer live on gen[i]->large_objects. + * Failing to do so caused #17574. */ bdescr *nonmoving_large_objects = NULL; @@ -83,6 +87,9 @@ bdescr *nonmoving_marked_large_objects = NULL; memcount n_nonmoving_large_blocks = 0; memcount n_nonmoving_marked_large_blocks = 0; +memcount nonmoving_large_words = 0; +memcount nonmoving_compact_words = 0; + bdescr *nonmoving_compact_objects = NULL; bdescr *nonmoving_marked_compact_objects = NULL; memcount n_nonmoving_compact_blocks = 0; @@ -1745,7 +1752,7 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin) struct NonmovingSegment *seg = nonmovingGetSegment((StgPtr) p); nonmoving_block_idx block_idx = nonmovingGetBlockIdx((StgPtr) p); nonmovingSetMark(seg, block_idx); - nonmoving_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_); + nonmoving_segment_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_); } // If we found a indirection to shortcut keep going. ===================================== rts/sm/NonMovingMark.h ===================================== @@ -127,6 +127,11 @@ extern bdescr *nonmoving_large_objects, *nonmoving_marked_large_objects, extern memcount n_nonmoving_large_blocks, n_nonmoving_marked_large_blocks, n_nonmoving_compact_blocks, n_nonmoving_marked_compact_blocks; +// The size of live large/compact objects in words. +// Only updated at the end of nonmoving GC. +extern memcount nonmoving_large_words, + nonmoving_compact_words; + extern StgTSO *nonmoving_old_threads; extern StgWeak *nonmoving_old_weak_ptr_list; extern StgTSO *nonmoving_threads; ===================================== rts/sm/Storage.c ===================================== @@ -42,6 +42,7 @@ #include "GC.h" #include "Evac.h" #include "NonMovingAllocate.h" +#include "sm/NonMovingMark.h" #if defined(ios_HOST_OS) || defined(darwin_HOST_OS) #include "Hash.h" #endif @@ -1615,7 +1616,12 @@ W_ genLiveWords (generation *gen) W_ genLiveBlocks (generation *gen) { - return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks; + W_ nonmoving_blocks = 0; + // The nonmoving heap contains some blocks that live outside the regular generation structure. + if (gen == oldest_gen && RtsFlags.GcFlags.useNonmoving){ + nonmoving_blocks = n_nonmoving_large_blocks + n_nonmoving_marked_large_blocks + n_nonmoving_compact_blocks + n_nonmoving_marked_compact_blocks; + } + return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks + nonmoving_blocks; } W_ gcThreadLiveWords (uint32_t i, uint32_t g) @@ -1711,6 +1717,9 @@ StgWord calcTotalLargeObjectsW (void) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { totalW += generations[g].n_large_words; } + + totalW += nonmoving_large_words; + return totalW; } @@ -1722,6 +1731,9 @@ StgWord calcTotalCompactW (void) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { totalW += generations[g].n_compact_blocks * BLOCK_SIZE_W; } + + totalW += nonmoving_compact_words; + return totalW; } ===================================== testsuite/.gitignore ===================================== @@ -732,6 +732,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ffi/should_run/ffi021 /tests/ffi/should_run/ffi022 /tests/ffi/should_run/ffi023 +/tests/ffi/should_run/rts_clearMemory /tests/ffi/should_run/ffi_parsing_001 /tests/ffi/should_run/fptr01 /tests/ffi/should_run/fptr02 ===================================== testsuite/tests/ffi/should_run/Makefile ===================================== @@ -25,6 +25,9 @@ T5594_setup : ffi023_setup : '$(TEST_HC)' $(TEST_HC_OPTS) -c ffi023.hs +rts_clearMemory_setup : + '$(TEST_HC)' $(TEST_HC_OPTS) -c rts_clearMemory.hs + .PHONY: Capi_Ctype_001 Capi_Ctype_001: '$(HSC2HS)' Capi_Ctype_A_001.hsc ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -191,7 +191,6 @@ test('T8083', [omit_ways(['ghci']), req_c], compile_and_run, ['T8083_c.c']) test('T9274', [omit_ways(['ghci'])], compile_and_run, ['']) test('ffi023', [ omit_ways(['ghci']), - expect_broken_for(23089, ['threaded2', 'nonmoving_thr', 'nonmoving_thr_sanity', 'nonmoving_thr_ghc']), extra_run_opts('1000 4'), js_broken(22363), pre_cmd('$MAKE -s --no-print-directory ffi023_setup') ], @@ -200,6 +199,18 @@ test('ffi023', [ omit_ways(['ghci']), # needs it. compile_and_run, ['ffi023_c.c']) +test('rts_clearMemory', [ + # We only care about different GC configurations under the + # single-threaded RTS for the time being. + only_ways(['normal', 'optasm' ,'g1', 'nursery_chunks', 'nonmoving', 'compacting_gc']), + extra_ways(['g1', 'nursery_chunks', 'nonmoving', 'compacting_gc']), + # On windows, nonmoving way fails with bad exit code (2816) + when(opsys('mingw32'), fragile(23091)), + js_broken(22363), + pre_cmd('$MAKE -s --no-print-directory rts_clearMemory_setup') ], + # Same hack as ffi023 + compile_and_run, ['rts_clearMemory_c.c -no-hs-main']) + test('T12134', [omit_ways(['ghci']), req_c], compile_and_run, ['T12134_c.c']) test('T12614', [omit_ways(['ghci']), req_c], compile_and_run, ['T12614_c.c']) ===================================== testsuite/tests/ffi/should_run/ffi023_c.c ===================================== @@ -4,7 +4,6 @@ HsInt out (HsInt x) { - performBlockingMajorGC(); - rts_clearMemory(); + hs_perform_gc(); return incall(x); } ===================================== testsuite/tests/ffi/should_run/rts_clearMemory.hs ===================================== @@ -0,0 +1,15 @@ +module RtsClearMemory + ( foo, + ) +where + +import Control.DeepSeq +import Control.Exception +import Data.Functor + +-- | Behold, mortal! This function doth summon forth a horde of trash, +-- mere playthings for the garbage collector's insatiable appetite. +foo :: Int -> IO () +foo n = void $ evaluate $ force [0 .. n] + +foreign export ccall foo :: Int -> IO () ===================================== testsuite/tests/ffi/should_run/rts_clearMemory_c.c ===================================== @@ -0,0 +1,12 @@ +#include +#include "rts_clearMemory_stub.h" + +int main(int argc, char *argv[]) { + hs_init_with_rtsopts(&argc, &argv); + + for (int i = 0; i < 8; ++i) { + foo(1000000); + hs_perform_gc(); + rts_clearMemory(); + } +} ===================================== testsuite/tests/rts/T17574.hs ===================================== @@ -0,0 +1,40 @@ +-- | Check that large objects are properly accounted for by GHC.Stats +module Main (main) where + +import Control.Monad +import Control.Exception +import Control.Concurrent +import System.Mem +import System.Exit +import GHC.Stats +import GHC.Compact +import Data.List (replicate) + +import qualified Data.ByteString.Char8 as BS + +doGC :: IO () +doGC = do + performMajorGC + threadDelay 1000 -- small delay to allow GC to run when using concurrent gc + +main :: IO () +main = do + let size = 4096*2 + largeString <- evaluate $ BS.replicate size 'A' + compactString <- compact $ replicate size 'A' + doGC + doGC -- run GC twice to make sure the objects end up in the oldest gen + stats <- getRTSStats + let large_obj_bytes = gcdetails_large_objects_bytes $ gc stats + let compact_obj_bytes = gcdetails_compact_bytes $ gc stats + -- assert that large_obj_bytes is at least as big as size + -- this indicates that `largeString` is being accounted for by the stats department + when (large_obj_bytes < fromIntegral size) $ do + putStrLn $ "large_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size + exitFailure + when (compact_obj_bytes < fromIntegral size) $ do + putStrLn $ "compact_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size + exitFailure + -- keep them alive + print $ BS.length largeString + print $ length $ getCompact compactString ===================================== testsuite/tests/rts/T17574.stdout ===================================== @@ -0,0 +1,2 @@ +8192 +8192 ===================================== testsuite/tests/rts/all.T ===================================== @@ -573,3 +573,5 @@ test('decodeMyStack_emptyListForMissingFlag', test('T22795a', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded']) test('T22795b', [only_ways(['normal']), js_skip], compile_and_run, ['-single-threaded']) test('T22795c', [only_ways(['normal']), js_skip], compile_and_run, ['-threaded -single-threaded']) + +test('T17574', [js_skip], compile_and_run, ['-with-rtsopts -T']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe1bf91cd3ab288f29ea956f772d3d6b2134a56c...6991f2b74783b39d201da3c9ac1836e17453f006 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe1bf91cd3ab288f29ea956f772d3d6b2134a56c...6991f2b74783b39d201da3c9ac1836e17453f006 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 07:47:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 25 Mar 2023 03:47:01 -0400 Subject: [Git][ghc/ghc][master] 2 commits: rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 Message-ID: <641ea6f55cbe5_13561a134ca2bc2433f5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 8 changed files: - rts/HsFFI.c - rts/RtsSymbols.c - testsuite/.gitignore - testsuite/tests/ffi/should_run/Makefile - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ffi/should_run/ffi023_c.c - + testsuite/tests/ffi/should_run/rts_clearMemory.hs - + testsuite/tests/ffi/should_run/rts_clearMemory_c.c Changes: ===================================== rts/HsFFI.c ===================================== @@ -24,8 +24,8 @@ hs_set_argv(int argc, char *argv[]) void hs_perform_gc(void) { - /* Hmmm, the FFI spec is a bit vague, but it seems to imply a major GC... */ - performMajorGC(); + /* Hmmm, the FFI spec is a bit vague, but it seems to imply a blocking major GC... */ + performBlockingMajorGC(); } // Lock the stable pointer table ===================================== rts/RtsSymbols.c ===================================== @@ -649,6 +649,7 @@ extern char **environ; SymI_HasProto(updateRemembSetPushClosure_) \ SymI_HasProto(performGC) \ SymI_HasProto(performMajorGC) \ + SymI_HasProto(performBlockingMajorGC) \ SymI_HasProto(prog_argc) \ SymI_HasProto(prog_argv) \ SymI_HasDataProto(stg_putMVarzh) \ ===================================== testsuite/.gitignore ===================================== @@ -732,6 +732,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ffi/should_run/ffi021 /tests/ffi/should_run/ffi022 /tests/ffi/should_run/ffi023 +/tests/ffi/should_run/rts_clearMemory /tests/ffi/should_run/ffi_parsing_001 /tests/ffi/should_run/fptr01 /tests/ffi/should_run/fptr02 ===================================== testsuite/tests/ffi/should_run/Makefile ===================================== @@ -25,6 +25,9 @@ T5594_setup : ffi023_setup : '$(TEST_HC)' $(TEST_HC_OPTS) -c ffi023.hs +rts_clearMemory_setup : + '$(TEST_HC)' $(TEST_HC_OPTS) -c rts_clearMemory.hs + .PHONY: Capi_Ctype_001 Capi_Ctype_001: '$(HSC2HS)' Capi_Ctype_A_001.hsc ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -191,7 +191,6 @@ test('T8083', [omit_ways(['ghci']), req_c], compile_and_run, ['T8083_c.c']) test('T9274', [omit_ways(['ghci'])], compile_and_run, ['']) test('ffi023', [ omit_ways(['ghci']), - expect_broken_for(23089, ['threaded2', 'nonmoving_thr', 'nonmoving_thr_sanity', 'nonmoving_thr_ghc']), extra_run_opts('1000 4'), js_broken(22363), pre_cmd('$MAKE -s --no-print-directory ffi023_setup') ], @@ -200,6 +199,18 @@ test('ffi023', [ omit_ways(['ghci']), # needs it. compile_and_run, ['ffi023_c.c']) +test('rts_clearMemory', [ + # We only care about different GC configurations under the + # single-threaded RTS for the time being. + only_ways(['normal', 'optasm' ,'g1', 'nursery_chunks', 'nonmoving', 'compacting_gc']), + extra_ways(['g1', 'nursery_chunks', 'nonmoving', 'compacting_gc']), + # On windows, nonmoving way fails with bad exit code (2816) + when(opsys('mingw32'), fragile(23091)), + js_broken(22363), + pre_cmd('$MAKE -s --no-print-directory rts_clearMemory_setup') ], + # Same hack as ffi023 + compile_and_run, ['rts_clearMemory_c.c -no-hs-main']) + test('T12134', [omit_ways(['ghci']), req_c], compile_and_run, ['T12134_c.c']) test('T12614', [omit_ways(['ghci']), req_c], compile_and_run, ['T12614_c.c']) ===================================== testsuite/tests/ffi/should_run/ffi023_c.c ===================================== @@ -4,7 +4,6 @@ HsInt out (HsInt x) { - performBlockingMajorGC(); - rts_clearMemory(); + hs_perform_gc(); return incall(x); } ===================================== testsuite/tests/ffi/should_run/rts_clearMemory.hs ===================================== @@ -0,0 +1,15 @@ +module RtsClearMemory + ( foo, + ) +where + +import Control.DeepSeq +import Control.Exception +import Data.Functor + +-- | Behold, mortal! This function doth summon forth a horde of trash, +-- mere playthings for the garbage collector's insatiable appetite. +foo :: Int -> IO () +foo n = void $ evaluate $ force [0 .. n] + +foreign export ccall foo :: Int -> IO () ===================================== testsuite/tests/ffi/should_run/rts_clearMemory_c.c ===================================== @@ -0,0 +1,12 @@ +#include +#include "rts_clearMemory_stub.h" + +int main(int argc, char *argv[]) { + hs_init_with_rtsopts(&argc, &argv); + + for (int i = 0; i < 8; ++i) { + foo(1000000); + hs_perform_gc(); + rts_clearMemory(); + } +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62fa7faaf8ca2d34cda3e3b7c4c6b2d13efa16fe...d9ae24ad3de71e14364665ff1741aa3551e7c526 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62fa7faaf8ca2d34cda3e3b7c4c6b2d13efa16fe...d9ae24ad3de71e14364665ff1741aa3551e7c526 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 07:47:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 25 Mar 2023 03:47:41 -0400 Subject: [Git][ghc/ghc][master] Improve documentation for resizing of byte arrays Message-ID: <641ea71d32a34_13561a1386575024727e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - 1 changed file: - compiler/GHC/Builtin/primops.txt.pp Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1567,7 +1567,16 @@ primop ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp SmallMutableArray# s v -> Int# -> State# s -> State# s {Shrink mutable array to new specified size, in the specified state thread. The new size argument must be less than or - equal to the current size as reported by 'getSizeofSmallMutableArray#'.} + equal to the current size as reported by 'getSizeofSmallMutableArray#'. + + Assuming the non-profiling RTS, for the copying garbage collector + (default) this primitive compiles to an O(1) operation in C--, modifying + the array in-place. For the non-moving garbage collector, however, the + time is proportional to the number of elements shrinked out. Backends + bypassing C-- representation (such as JavaScript) might behave + differently. + + @since 0.6.1} with out_of_line = True has_side_effects = True @@ -1591,14 +1600,17 @@ primop SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp primop SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp SmallMutableArray# s v -> Int# - {Return the number of elements in the array. Note that this is deprecated - as it is unsafe in the presence of shrink and resize operations on the - same small mutable array.} + {Return the number of elements in the array. __Deprecated__, it is + unsafe in the presence of 'shrinkSmallMutableArray#' and @resizeSmallMutableArray#@ + operations on the same small mutable array.} with deprecated_msg = { Use 'getSizeofSmallMutableArray#' instead } primop GetSizeofSmallMutableArrayOp "getSizeofSmallMutableArray#" GenPrimOp SmallMutableArray# s v -> State# s -> (# State# s, Int# #) - {Return the number of elements in the array.} + {Return the number of elements in the array, correctly accounting for + the effect of 'shrinkSmallMutableArray#' and @resizeSmallMutableArray#@. + + @since 0.6.1} primop IndexSmallArrayOp "indexSmallArray#" GenPrimOp SmallArray# v -> Int# -> (# v #) @@ -1807,13 +1819,19 @@ primop ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> State# s {Shrink mutable byte array to new specified size (in bytes), in the specified state thread. The new size argument must be less than or - equal to the current size as reported by 'getSizeofMutableByteArray#'.} + equal to the current size as reported by 'getSizeofMutableByteArray#'. + + Assuming the non-profiling RTS, this primitive compiles to an O(1) + operation in C--, modifying the array in-place. Backends bypassing C-- + representation (such as JavaScript) might behave differently. + + @since 0.4.0.0} with out_of_line = True has_side_effects = True primop ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #) - {Resize (unpinned) mutable byte array to new specified size (in bytes). + {Resize mutable byte array to new specified size (in bytes), shrinking or growing it. The returned 'MutableByteArray#' is either the original 'MutableByteArray#' resized in-place or, if not possible, a newly allocated (unpinned) 'MutableByteArray#' (with the original content @@ -1823,7 +1841,9 @@ primop ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp not be accessed anymore after a 'resizeMutableByteArray#' has been performed. Moreover, no reference to the old one should be kept in order to allow garbage collection of the original 'MutableByteArray#' in - case a new 'MutableByteArray#' had to be allocated.} + case a new 'MutableByteArray#' had to be allocated. + + @since 0.4.0.0} with out_of_line = True has_side_effects = True @@ -1839,14 +1859,18 @@ primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# - {Return the size of the array in bytes. Note that this is deprecated as it is - unsafe in the presence of shrink and resize operations on the same mutable byte + {Return the size of the array in bytes. __Deprecated__, it is + unsafe in the presence of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#' + operations on the same mutable byte array.} with deprecated_msg = { Use 'getSizeofMutableByteArray#' instead } primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp MutableByteArray# s -> State# s -> (# State# s, Int# #) - {Return the number of elements in the array.} + {Return the number of elements in the array, correctly accounting for + the effect of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#'. + + @since 0.5.0.0} #include "bytearray-ops.txt.pp" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80729d96e47c99dc38e83612dfcfe01cf565eac0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80729d96e47c99dc38e83612dfcfe01cf565eac0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 12:54:35 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 25 Mar 2023 08:54:35 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] 43 commits: Add structured error messages for GHC.Tc.Utils.TcMType Message-ID: <641eef0b50237_13561a18960c9027559d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c33bc50c by Simon Peyton Jones at 2023-03-25T12:55:57+00:00 DRAFT: Refactor the way we establish a canonical constraint Relevant to #22194 Incomplete; but I'd like to see the CI results - - - - - 9699bda3 by Simon Peyton Jones at 2023-03-25T12:55:57+00:00 Wibbles - - - - - 09af8c14 by Simon Peyton Jones at 2023-03-25T12:55:57+00:00 Wibbles - - - - - d33e0a98 by Simon Peyton Jones at 2023-03-25T12:55:57+00:00 Wibbles - - - - - 72df8811 by Simon Peyton Jones at 2023-03-25T12:55:57+00:00 Use a flag-based approach for checkTyEqRhs ...looks much nicer - - - - - 54f06557 by Simon Peyton Jones at 2023-03-25T12:55:57+00:00 Wibble - - - - - e7087aff by Simon Peyton Jones at 2023-03-25T12:55:57+00:00 Bug fixes - - - - - f645ea22 by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 More bug fixes - - - - - 2ecbc9f8 by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 Minor fixes - - - - - 5608ae39 by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 Fix isConcreteTyCon Adds a synIsConcrete to SynonymTyCon - - - - - 353bd2b9 by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 More wibbles - - - - - d3837f5d by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 Add a fast path simpleUnifyCheck - - - - - cf91ebff by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 Wibble - - - - - 1edf1ffe by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 Respond to Richard's review - - - - - 87c1ce1b by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 More wibbles, prompted by talking with Richard - - - - - 3a676ff1 by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 More wibbles - - - - - ca1d46bf by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 Wibbles - - - - - c9310d19 by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 Wibble - - - - - 17be7ead by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 Wibbles - - - - - bbba6b57 by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 wibbles - - - - - 2779ca96 by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 Wibbles - - - - - e9ffd4c4 by Simon Peyton Jones at 2023-03-25T12:55:58+00:00 Better orientation Should fix perf regression in T15703 - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/TyCl.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/554c9a5df5374f3c9c4253c69e98e08dacf20870...e9ffd4c4b4a1245cf830a574d0cb30fe60a1e954 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/554c9a5df5374f3c9c4253c69e98e08dacf20870...e9ffd4c4b4a1245cf830a574d0cb30fe60a1e954 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 13:02:35 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 25 Mar 2023 09:02:35 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Rename note Message-ID: <641ef0eb7c05c_13561a18960c90276131@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 9808cd38 by Simon Peyton Jones at 2023-03-25T13:04:03+00:00 Rename note - - - - - 1 changed file: - compiler/GHC/Tc/Solver/Equality.hs Changes: ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -1600,9 +1600,10 @@ canEqCanLHS2 ev eq_rel swapped lhs1 ps_xi1 lhs2 ps_xi2 mco ; let tvs1 = tyCoVarsOfTypes fun_args1 tvs2 = tyCoVarsOfTypes fun_args2 + -- See Note [Orienting TyFamLHS/TyFamLHS] swap_for_size = typesSize fun_args2 > typesSize fun_args1 - -- See Note [Put the larger type on the left] + -- See Note [Orienting TyFamLHS/TyFamLHS] swap_for_rewriting = anyVarSet (isTouchableMetaTyVar tclvl) tvs2 && -- See Note [Put touchable variables on the left] not (anyVarSet (isTouchableMetaTyVar tclvl) tvs1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9808cd3895ae203220998fb4fe307039a0887375 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9808cd3895ae203220998fb4fe307039a0887375 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 15:14:15 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 25 Mar 2023 11:14:15 -0400 Subject: [Git][ghc/ghc][wip/supersven/StgRetBCO-struct] Sanity.c Message-ID: <641f0fc741ebd_13561a1ad49cb02871e@gitlab.mail> Sven Tennie pushed to branch wip/supersven/StgRetBCO-struct at Glasgow Haskell Compiler / GHC Commits: 775ea030 by Sven Tennie at 2023-03-25T15:14:02+00:00 Sanity.c - - - - - 2 changed files: - rts/sm/Sanity.c - rts/sm/Scav.c Changes: ===================================== rts/sm/Sanity.c ===================================== @@ -125,7 +125,7 @@ checkStackFrame( StgPtr c ) case CATCH_RETRY_FRAME: case CATCH_STM_FRAME: case CATCH_FRAME: - // small bitmap cases (<= 32 entries) + // small bitmap cases (<= 27 entries (32bit arch) or <= 58 entries (64bit arch)) case UNDERFLOW_FRAME: case STOP_FRAME: case RET_SMALL: @@ -135,16 +135,14 @@ checkStackFrame( StgPtr c ) return 1 + size; case RET_BCO: { - // TODO: Adjust - StgBCO *bco; - uint32_t size; - bco = (StgBCO *)*(c+1); - size = BCO_BITMAP_SIZE(bco); - checkLargeBitmap((StgPtr)c + 2, BCO_BITMAP(bco), size); + StgRetBCO* retBCO = (StgRetBCO*) c; + StgWord size; + size = BCO_BITMAP_SIZE(retBCO->bco); + checkLargeBitmap((StgPtr) &retBCO->args, BCO_BITMAP(retBCO->bco), size); return 2 + size; } - case RET_BIG: // large bitmap (> 32 entries) + case RET_BIG: // large bitmap (> 27 entries (32bit arch) or > 58 entries (64bit arch)) size = GET_LARGE_BITMAP(&info->i)->size; checkLargeBitmap((StgPtr)c + 1, GET_LARGE_BITMAP(&info->i), size); return 1 + size; ===================================== rts/sm/Scav.c ===================================== @@ -1984,7 +1984,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) case RET_BCO: { StgRetBCO* retBCO; - StgWord size; + StgHalfWord size; retBCO = (StgRetBCO *) p; evacuate((StgClosure **) &retBCO->bco); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/775ea03078b2bd1039458e7d1d9242d904523103 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/775ea03078b2bd1039458e7d1d9242d904523103 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 21:53:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 25 Mar 2023 17:53:50 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 Message-ID: <641f6d6e531ca_13561a21441c103485af@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c1fe2608 by Ben Gamari at 2023-03-25T17:53:39-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - 1f85621b by Ben Gamari at 2023-03-25T17:53:39-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 981adc51 by Ryan Scott at 2023-03-25T17:53:40-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 16 changed files: - compiler/GHC/Builtin/primops.txt.pp - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/changelog.md - rts/HsFFI.c - rts/RtsSymbols.c - + rts/ZeroSlop.c - rts/include/Cmm.h - rts/include/rts/storage/ClosureMacros.h - rts/rts.cabal.in - testsuite/.gitignore - testsuite/tests/ffi/should_run/Makefile - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ffi/should_run/ffi023_c.c - + testsuite/tests/ffi/should_run/rts_clearMemory.hs - + testsuite/tests/ffi/should_run/rts_clearMemory_c.c Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1567,7 +1567,16 @@ primop ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp SmallMutableArray# s v -> Int# -> State# s -> State# s {Shrink mutable array to new specified size, in the specified state thread. The new size argument must be less than or - equal to the current size as reported by 'getSizeofSmallMutableArray#'.} + equal to the current size as reported by 'getSizeofSmallMutableArray#'. + + Assuming the non-profiling RTS, for the copying garbage collector + (default) this primitive compiles to an O(1) operation in C--, modifying + the array in-place. For the non-moving garbage collector, however, the + time is proportional to the number of elements shrinked out. Backends + bypassing C-- representation (such as JavaScript) might behave + differently. + + @since 0.6.1} with out_of_line = True has_side_effects = True @@ -1591,14 +1600,17 @@ primop SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp primop SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp SmallMutableArray# s v -> Int# - {Return the number of elements in the array. Note that this is deprecated - as it is unsafe in the presence of shrink and resize operations on the - same small mutable array.} + {Return the number of elements in the array. __Deprecated__, it is + unsafe in the presence of 'shrinkSmallMutableArray#' and @resizeSmallMutableArray#@ + operations on the same small mutable array.} with deprecated_msg = { Use 'getSizeofSmallMutableArray#' instead } primop GetSizeofSmallMutableArrayOp "getSizeofSmallMutableArray#" GenPrimOp SmallMutableArray# s v -> State# s -> (# State# s, Int# #) - {Return the number of elements in the array.} + {Return the number of elements in the array, correctly accounting for + the effect of 'shrinkSmallMutableArray#' and @resizeSmallMutableArray#@. + + @since 0.6.1} primop IndexSmallArrayOp "indexSmallArray#" GenPrimOp SmallArray# v -> Int# -> (# v #) @@ -1807,13 +1819,19 @@ primop ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> State# s {Shrink mutable byte array to new specified size (in bytes), in the specified state thread. The new size argument must be less than or - equal to the current size as reported by 'getSizeofMutableByteArray#'.} + equal to the current size as reported by 'getSizeofMutableByteArray#'. + + Assuming the non-profiling RTS, this primitive compiles to an O(1) + operation in C--, modifying the array in-place. Backends bypassing C-- + representation (such as JavaScript) might behave differently. + + @since 0.4.0.0} with out_of_line = True has_side_effects = True primop ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #) - {Resize (unpinned) mutable byte array to new specified size (in bytes). + {Resize mutable byte array to new specified size (in bytes), shrinking or growing it. The returned 'MutableByteArray#' is either the original 'MutableByteArray#' resized in-place or, if not possible, a newly allocated (unpinned) 'MutableByteArray#' (with the original content @@ -1823,7 +1841,9 @@ primop ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp not be accessed anymore after a 'resizeMutableByteArray#' has been performed. Moreover, no reference to the old one should be kept in order to allow garbage collection of the original 'MutableByteArray#' in - case a new 'MutableByteArray#' had to be allocated.} + case a new 'MutableByteArray#' had to be allocated. + + @since 0.4.0.0} with out_of_line = True has_side_effects = True @@ -1839,14 +1859,18 @@ primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# - {Return the size of the array in bytes. Note that this is deprecated as it is - unsafe in the presence of shrink and resize operations on the same mutable byte + {Return the size of the array in bytes. __Deprecated__, it is + unsafe in the presence of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#' + operations on the same mutable byte array.} with deprecated_msg = { Use 'getSizeofMutableByteArray#' instead } primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp MutableByteArray# s -> State# s -> (# State# s, Int# #) - {Return the number of elements in the array.} + {Return the number of elements in the array, correctly accounting for + the effect of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#'. + + @since 0.5.0.0} #include "bytearray-ops.txt.pp" ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -68,7 +68,7 @@ module GHC.TypeLits ) where -import GHC.Base ( Eq(..), Functor(..), Ord(..), Ordering(..), String +import GHC.Base ( Bool(..), Eq(..), Functor(..), Ord(..), Ordering(..), String , (.), otherwise, withDict, Void, (++) , errorWithoutStackTrace) import GHC.Types(Symbol, Char, TYPE) @@ -374,6 +374,14 @@ data KnownSymbolInstance (s :: Symbol) where knownSymbolInstance :: SSymbol s -> KnownSymbolInstance s knownSymbolInstance ss = withKnownSymbol ss KnownSymbolInstance +-- | @since 4.19.0.0 +instance Eq (SSymbol s) where + _ == _ = True + +-- | @since 4.19.0.0 +instance Ord (SSymbol s) where + compare _ _ = EQ + -- | @since 4.18.0.0 instance Show (SSymbol s) where showsPrec p (UnsafeSSymbol s) @@ -467,6 +475,14 @@ data KnownCharInstance (n :: Char) where knownCharInstance :: SChar c -> KnownCharInstance c knownCharInstance sc = withKnownChar sc KnownCharInstance +-- | @since 4.19.0.0 +instance Eq (SChar c) where + _ == _ = True + +-- | @since 4.19.0.0 +instance Ord (SChar c) where + compare _ _ = EQ + -- | @since 4.18.0.0 instance Show (SChar c) where showsPrec p (UnsafeSChar c) ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -378,6 +378,14 @@ data KnownNatInstance (n :: Nat) where knownNatInstance :: SNat n -> KnownNatInstance n knownNatInstance sn = withKnownNat sn KnownNatInstance +-- | @since 4.19.0.0 +instance Eq (SNat n) where + _ == _ = True + +-- | @since 4.19.0.0 +instance Ord (SNat n) where + compare _ _ = EQ + -- | @since 4.18.0.0 instance Show (SNat n) where showsPrec p (UnsafeSNat n) ===================================== libraries/base/changelog.md ===================================== @@ -14,6 +14,8 @@ * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) * Implement more members of `instance Foldable (Compose f g)` explicitly. ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) + * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. + ([CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148)) ## 4.18.0.0 *TBA* * Shipped with GHC 9.6.1 ===================================== rts/HsFFI.c ===================================== @@ -24,8 +24,8 @@ hs_set_argv(int argc, char *argv[]) void hs_perform_gc(void) { - /* Hmmm, the FFI spec is a bit vague, but it seems to imply a major GC... */ - performMajorGC(); + /* Hmmm, the FFI spec is a bit vague, but it seems to imply a blocking major GC... */ + performBlockingMajorGC(); } // Lock the stable pointer table ===================================== rts/RtsSymbols.c ===================================== @@ -649,6 +649,7 @@ extern char **environ; SymI_HasProto(updateRemembSetPushClosure_) \ SymI_HasProto(performGC) \ SymI_HasProto(performMajorGC) \ + SymI_HasProto(performBlockingMajorGC) \ SymI_HasProto(prog_argc) \ SymI_HasProto(prog_argv) \ SymI_HasDataProto(stg_putMVarzh) \ ===================================== rts/ZeroSlop.c ===================================== @@ -0,0 +1,27 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2012 + * + * Utilities for zeroing slop callable from Cmm + * + * N.B. If you are in C you should rather using the inlineable utilities + * (e.g. overwritingClosure) defined in ClosureMacros.h. + * + * -------------------------------------------------------------------------- */ + +#include "Rts.h" + +void stg_overwritingClosure (StgClosure *p) +{ + overwritingClosure(p); +} + +void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) +{ + overwritingMutableClosureOfs(p, offset); +} + +void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */) +{ + overwritingClosureSize(p, size); +} ===================================== rts/include/Cmm.h ===================================== @@ -647,9 +647,9 @@ #define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n)) #if defined(PROFILING) || defined(DEBUG) -#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" overwritingClosureSize(c "ptr", size) -#define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr") -#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" overwritingMutableClosureOfs(c "ptr", off) +#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" stg_overwritingClosureSize(c "ptr", size) +#define OVERWRITING_CLOSURE(c) foreign "C" stg_overwritingClosure(c "ptr") +#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" stg_overwritingMutableClosureOfs(c "ptr", off) #else #define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */ #define OVERWRITING_CLOSURE(c) /* nothing */ @@ -657,7 +657,7 @@ * this whenever profiling is enabled as described in Note [slop on the heap] * in Storage.c. */ #define OVERWRITING_CLOSURE_MUTABLE(c, off) \ - if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off); } + if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" stg_overwritingMutableClosureOfs(c "ptr", off); } #endif #define IS_STACK_CLEAN(stack) \ ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -517,16 +517,12 @@ void LDV_recordDead (const StgClosure *c, uint32_t size); RTS_PRIVATE bool isInherentlyUsed ( StgHalfWord closure_type ); #endif -EXTERN_INLINE void -zeroSlop ( - StgClosure *p, - uint32_t offset, /*< offset to start zeroing at, in words */ - uint32_t size, /*< total closure size, in words */ - bool known_mutable /*< is this a closure who's slop we can always zero? */ - ); - -EXTERN_INLINE void -zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) +INLINE_HEADER void +zeroSlop (StgClosure *p, + uint32_t offset, /*< offset to start zeroing at, in words */ + uint32_t size, /*< total closure size, in words */ + bool known_mutable /*< is this a closure who's slop we can always zero? */ + ) { // see Note [zeroing slop when overwriting closures], also #8402 @@ -539,9 +535,8 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) #endif ; - const bool can_zero_immutable_slop = - // Only if we're running single threaded. - RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1; + // Only if we're running single threaded. + const bool can_zero_immutable_slop = getNumCapabilities() == 1; const bool zero_slop_immutable = want_to_zero_immutable_slop && can_zero_immutable_slop; @@ -574,8 +569,10 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) } } -EXTERN_INLINE void overwritingClosure (StgClosure *p); -EXTERN_INLINE void overwritingClosure (StgClosure *p) +// N.B. the stg_* variants of the utilities below are only for calling from +// Cmm. The INLINE_HEADER functions should be used when in C. +void stg_overwritingClosure (StgClosure *p); +INLINE_HEADER void overwritingClosure (StgClosure *p) { W_ size = closure_sizeW(p); #if defined(PROFILING) @@ -585,15 +582,13 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p) zeroSlop(p, sizeofW(StgThunkHeader), size, /*known_mutable=*/false); } + // Version of 'overwritingClosure' which overwrites only a suffix of a // closure. The offset is expressed in words relative to 'p' and shall // be less than or equal to closure_sizeW(p), and usually at least as // large as the respective thunk header. -EXTERN_INLINE void -overwritingMutableClosureOfs (StgClosure *p, uint32_t offset); - -EXTERN_INLINE void -overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) +void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset); +INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) { // Since overwritingClosureOfs is only ever called by: // @@ -610,8 +605,8 @@ overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) } // Version of 'overwritingClosure' which takes closure size as argument. -EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size /* in words */); -EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size) +void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */); +INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size) { // This function is only called from stg_AP_STACK so we can assume it's not // inherently used. ===================================== rts/rts.cabal.in ===================================== @@ -603,6 +603,7 @@ library TSANUtils.c WSDeque.c Weak.c + ZeroSlop.c eventlog/EventLog.c eventlog/EventLogWriter.c hooks/FlagDefaults.c ===================================== testsuite/.gitignore ===================================== @@ -732,6 +732,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ffi/should_run/ffi021 /tests/ffi/should_run/ffi022 /tests/ffi/should_run/ffi023 +/tests/ffi/should_run/rts_clearMemory /tests/ffi/should_run/ffi_parsing_001 /tests/ffi/should_run/fptr01 /tests/ffi/should_run/fptr02 ===================================== testsuite/tests/ffi/should_run/Makefile ===================================== @@ -25,6 +25,9 @@ T5594_setup : ffi023_setup : '$(TEST_HC)' $(TEST_HC_OPTS) -c ffi023.hs +rts_clearMemory_setup : + '$(TEST_HC)' $(TEST_HC_OPTS) -c rts_clearMemory.hs + .PHONY: Capi_Ctype_001 Capi_Ctype_001: '$(HSC2HS)' Capi_Ctype_A_001.hsc ===================================== testsuite/tests/ffi/should_run/all.T ===================================== @@ -191,7 +191,6 @@ test('T8083', [omit_ways(['ghci']), req_c], compile_and_run, ['T8083_c.c']) test('T9274', [omit_ways(['ghci'])], compile_and_run, ['']) test('ffi023', [ omit_ways(['ghci']), - expect_broken_for(23089, ['threaded2', 'nonmoving_thr', 'nonmoving_thr_sanity', 'nonmoving_thr_ghc']), extra_run_opts('1000 4'), js_broken(22363), pre_cmd('$MAKE -s --no-print-directory ffi023_setup') ], @@ -200,6 +199,18 @@ test('ffi023', [ omit_ways(['ghci']), # needs it. compile_and_run, ['ffi023_c.c']) +test('rts_clearMemory', [ + # We only care about different GC configurations under the + # single-threaded RTS for the time being. + only_ways(['normal', 'optasm' ,'g1', 'nursery_chunks', 'nonmoving', 'compacting_gc']), + extra_ways(['g1', 'nursery_chunks', 'nonmoving', 'compacting_gc']), + # On windows, nonmoving way fails with bad exit code (2816) + when(opsys('mingw32'), fragile(23091)), + js_broken(22363), + pre_cmd('$MAKE -s --no-print-directory rts_clearMemory_setup') ], + # Same hack as ffi023 + compile_and_run, ['rts_clearMemory_c.c -no-hs-main']) + test('T12134', [omit_ways(['ghci']), req_c], compile_and_run, ['T12134_c.c']) test('T12614', [omit_ways(['ghci']), req_c], compile_and_run, ['T12614_c.c']) ===================================== testsuite/tests/ffi/should_run/ffi023_c.c ===================================== @@ -4,7 +4,6 @@ HsInt out (HsInt x) { - performBlockingMajorGC(); - rts_clearMemory(); + hs_perform_gc(); return incall(x); } ===================================== testsuite/tests/ffi/should_run/rts_clearMemory.hs ===================================== @@ -0,0 +1,15 @@ +module RtsClearMemory + ( foo, + ) +where + +import Control.DeepSeq +import Control.Exception +import Data.Functor + +-- | Behold, mortal! This function doth summon forth a horde of trash, +-- mere playthings for the garbage collector's insatiable appetite. +foo :: Int -> IO () +foo n = void $ evaluate $ force [0 .. n] + +foreign export ccall foo :: Int -> IO () ===================================== testsuite/tests/ffi/should_run/rts_clearMemory_c.c ===================================== @@ -0,0 +1,12 @@ +#include +#include "rts_clearMemory_stub.h" + +int main(int argc, char *argv[]) { + hs_init_with_rtsopts(&argc, &argv); + + for (int i = 0; i < 8; ++i) { + foo(1000000); + hs_perform_gc(); + rts_clearMemory(); + } +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6991f2b74783b39d201da3c9ac1836e17453f006...981adc5123f4763aab0c06e51990ced8d3e37071 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6991f2b74783b39d201da3c9ac1836e17453f006...981adc5123f4763aab0c06e51990ced8d3e37071 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Mar 25 23:00:56 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 25 Mar 2023 19:00:56 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Performance tweaks Message-ID: <641f7d28be097_13561a226d040835954d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: b1c87de8 by Simon Peyton Jones at 2023-03-25T23:02:05+00:00 Performance tweaks - - - - - 6 changed files: - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/indexed-types/should_compile/T3208b.stderr Changes: ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -23,7 +23,7 @@ module GHC.Core.TyCo.FVs almostDevoidCoVarOfCo, -- Injective free vars - injectiveVarsOfType, injectiveVarsOfTypes, + injectiveVarsOfType, injectiveVarsOfTypes, isInjectiveInType, invisibleVarsOfType, invisibleVarsOfTypes, -- Any and No Free vars @@ -53,7 +53,7 @@ module GHC.Core.TyCo.FVs import GHC.Prelude -import {-# SOURCE #-} GHC.Core.Type( partitionInvisibleTypes, coreView ) +import {-# SOURCE #-} GHC.Core.Type( partitionInvisibleTypes, coreView, rewriterView ) import {-# SOURCE #-} GHC.Core.Coercion( coercionLKind ) import GHC.Builtin.Types.Prim( funTyFlagTyCon ) @@ -806,6 +806,28 @@ visVarsOfTypes = foldMap visVarsOfType * * ********************************************************************* -} +isInjectiveInType :: TyVar -> Type -> Bool +-- True <=> tv /definitely/ appears injectively in ty +-- A bit more efficient that (tv `elemVarSet` injectiveTyVarsOfType ty) +-- Ignore occurence in coercions, and even in injective positions of +-- type families. +isInjectiveInType tv ty + = go ty + where + go ty | Just ty' <- rewriterView ty = go ty' + go (TyVarTy tv') = tv' == tv + go (AppTy f a) = go f || go a + go (FunTy _ w ty1 ty2) = go w || go ty1 || go ty2 + go (TyConApp tc tys) = go_tc tc tys + go (ForAllTy (Bndr tv' _) ty) = go (tyVarKind tv') + || (tv /= tv' && go ty) + go LitTy{} = False + go (CastTy ty _) = go ty + go CoercionTy{} = False + + go_tc tc tys | isTypeFamilyTyCon tc = False + | otherwise = any go tys + -- | Returns the free variables of a 'Type' that are in injective positions. -- Specifically, it finds the free variables while: -- @@ -836,15 +858,15 @@ injectiveVarsOfType :: Bool -- ^ Should we look under injective type families? -> Type -> FV injectiveVarsOfType look_under_tfs = go where - go ty | Just ty' <- coreView ty = go ty' - go (TyVarTy v) = unitFV v `unionFV` go (tyVarKind v) - go (AppTy f a) = go f `unionFV` go a - go (FunTy _ w ty1 ty2) = go w `unionFV` go ty1 `unionFV` go ty2 - go (TyConApp tc tys) = go_tc tc tys - go (ForAllTy (Bndr tv _) ty) = go (tyVarKind tv) `unionFV` delFV tv (go ty) - go LitTy{} = emptyFV - go (CastTy ty _) = go ty - go CoercionTy{} = emptyFV + go ty | Just ty' <- rewriterView ty = go ty' + go (TyVarTy v) = unitFV v `unionFV` go (tyVarKind v) + go (AppTy f a) = go f `unionFV` go a + go (FunTy _ w ty1 ty2) = go w `unionFV` go ty1 `unionFV` go ty2 + go (TyConApp tc tys) = go_tc tc tys + go (ForAllTy (Bndr tv _) ty) = go (tyVarKind tv) `unionFV` delFV tv (go ty) + go LitTy{} = emptyFV + go (CastTy ty _) = go ty + go CoercionTy{} = emptyFV go_tc tc tys | isTypeFamilyTyCon tc ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -184,7 +184,7 @@ module GHC.Core.Type ( seqType, seqTypes, -- * Other views onto Types - coreView, coreFullView, + coreView, coreFullView, rewriterView, tyConsOfType, @@ -361,6 +361,19 @@ import GHC.Data.Maybe ( orElse, isJust ) ************************************************************************ -} +rewriterView :: Type -> Maybe Type +-- Unwrap a type synonym only when either: +-- The type synonym is forgetful, or +-- the type synonym mentions a type family in its expansion +-- See Note [Rewriting synonyms] +{-# INLINE rewriterView #-} +rewriterView (TyConApp tc tys) + | isTypeSynonymTyCon tc + , isForgetfulSynTyCon tc || not (isFamFreeTyCon tc) + = expandSynTyConApp_maybe tc tys +rewriterView _other + = Nothing + coreView :: Type -> Maybe Type -- ^ This function strips off the /top layer only/ of a type synonym -- application (if any) its underlying representation type. @@ -402,7 +415,7 @@ expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type expandSynTyConApp_maybe tc arg_tys | Just (tvs, rhs) <- synTyConDefn_maybe tc , arg_tys `saturates` tyConArity tc - = Just (expand_syn tvs rhs arg_tys) + = Just $! (expand_syn tvs rhs arg_tys) | otherwise = Nothing ===================================== compiler/GHC/Core/Type.hs-boot ===================================== @@ -21,7 +21,8 @@ piResultTy :: HasDebugCallStack => Type -> Type -> Type typeKind :: HasDebugCallStack => Type -> Type typeTypeOrConstraint :: HasDebugCallStack => Type -> TypeOrConstraint -coreView :: Type -> Maybe Type +coreView :: Type -> Maybe Type +rewriterView :: Type -> Maybe Type isRuntimeRepTy :: Type -> Bool isLevityTy :: Type -> Bool isMultiplicityTy :: Type -> Bool ===================================== compiler/GHC/Tc/Solver/Rewrite.hs ===================================== @@ -665,16 +665,6 @@ rewrite_vector ki roles tys {-# INLINE rewrite_vector #-} --- Unwrap a type synonym only when either: --- The type synonym is forgetful, or --- the type synonym mentions a type family in its expansion --- See Note [Rewriting synonyms] -rewriterView :: TcType -> Maybe TcType -rewriterView ty@(TyConApp tc _) - | isForgetfulSynTyCon tc || (isTypeSynonymTyCon tc && not (isFamFreeTyCon tc)) - = coreView ty -rewriterView _other = Nothing - {- Note [Do not rewrite newtypes] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We flirted with unwrapping newtypes in the rewriter -- see GHC.Tc.Solver.Canonical ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Tc.Utils.Unify ( checkTyEqRhs, recurseIntoTyConApp, PuResult(..), failCheckWith, okCheckRefl, mapCheck, TyEqFlags(..), TyEqFamApp(..), AreUnifying(..), LevelCheck(..), FamAppBreaker, - famAppArgFlags, occursCheckTv, simpleUnifyCheck, checkPromoteFreeVars, + famAppArgFlags, simpleUnifyCheck, checkPromoteFreeVars, ) where import GHC.Prelude @@ -58,8 +58,8 @@ import GHC.Types.Name( Name, isSystemName ) import GHC.Core.Type import GHC.Core.TyCo.Rep -import GHC.Core.TyCo.FVs( injectiveVarsOfType ) -import GHC.Core.TyCo.Ppr( debugPprType, pprTyVar ) +import GHC.Core.TyCo.FVs( isInjectiveInType ) +import GHC.Core.TyCo.Ppr( debugPprType {- pprTyVar -} ) import GHC.Core.TyCon import GHC.Core.Coercion import GHC.Core.Multiplicity @@ -74,7 +74,6 @@ import GHC.Types.Var.Env import GHC.Types.Basic import GHC.Types.Unique.Set (nonDetEltsUniqSet) -import GHC.Utils.FV( fvVarSet ) import GHC.Utils.Error import GHC.Utils.Misc import GHC.Utils.Outputable as Outputable @@ -86,6 +85,7 @@ import GHC.Data.Bag import GHC.Data.FastString( fsLit ) import Control.Monad +import Data.Monoid as DM ( Any(..) ) import qualified Data.Semigroup as S ( (<>) ) {- ********************************************************************* @@ -1062,7 +1062,7 @@ definitely_poly ty | (tvs, theta, tau) <- tcSplitSigmaTy ty , (tv:_) <- tvs -- At least one tyvar , null theta -- No constraints; see (DP1) - , tv `elemVarSet` fvVarSet (injectiveVarsOfType True tau) + , tv `isInjectiveInType` tau -- The tyvar actually occurs (DP2), -- and occurs in an injective position (DP3). = True @@ -2075,30 +2075,27 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles -- Here we don't know about given equalities here; so we treat -- /any/ level outside this one as untouchable. Hence cur_lvl. - ; if not (touchabilityAndShapeTest cur_lvl tv1 ty2) + ; if not (touchabilityAndShapeTest cur_lvl tv1 ty2 + && simpleUnifyCheck False tv1 ty2) then not_ok_so_defer else - do { check_result <- uTypeCheckTouchableTyVarEq tv1 ty2 - ; case check_result of { - PuFail {} -> not_ok_so_defer ; - PuOK ty2' _ -> - do { co_k <- uType KindLevel kind_origin (typeKind ty2') (tyVarKind tv1) + do { co_k <- uType KindLevel kind_origin (typeKind ty2) (tyVarKind tv1) ; traceTc "uUnfilledVar2 ok" $ vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) - , ppr ty2 <+> dcolon <+> ppr (typeKind ty2') + , ppr ty2 <+> dcolon <+> ppr (typeKind ty2) , ppr (isReflCo co_k), ppr co_k ] ; if isReflCo co_k -- Only proceed if the kinds match -- NB: tv1 should still be unfilled, despite the kind unification -- because tv1 is not free in ty2' (or, hence, in its kind) - then do { writeMetaTyVar tv1 ty2' - ; return (mkNomReflCo ty2') } + then do { writeMetaTyVar tv1 ty2 + ; return (mkNomReflCo ty2) } else defer -- This cannot be solved now. See GHC.Tc.Solver.Canonical -- Note [Equalities with incompatible kinds] for how -- this will be dealt with in the solver - }}}} + }} where ty1 = mkTyVarTy tv1 kind_origin = KindEqOrigin ty1 ty2 origin (Just t_or_k) @@ -2526,6 +2523,7 @@ matchExpectedFunKind hs_ty n k = go n k * * ********************************************************************* -} +{- uTypeCheckTouchableTyVarEq :: TcTyVar -> TcType -> TcM (PuResult () TcType) -- The check may expand type synonyms to avoid an occurs check, -- so we must use the return type @@ -2555,10 +2553,10 @@ uTypeCheckTouchableTyVarEq lhs_tv rhs | otherwise = pprPanic "uTypeCheckTouchableTyVarEq" (ppr lhs_tv) -- TEFA_Fail: See Note [Prevent unification with type families] - +-} simpleUnifyCheck :: Bool -> TcTyVar -> TcType -> Bool --- A fast check that confirms that unification is OK +-- A fast check: True <=> unification is OK -- If it says 'False' then unification might still be OK, but -- it'll take more work to do -- use the full checkTypeEq -- @@ -2567,21 +2565,25 @@ simpleUnifyCheck :: Bool -> TcTyVar -> TcType -> Bool -- * Rejects a non-concrete type if lhs_tv is concrete -- * Rejects type families unless fam_ok=True -- * Does a level-check for type variables +-- +-- This function is pretty heavily used, so it's optimised not to allocate simpleUnifyCheck fam_ok lhs_tv rhs = go rhs where + !(occ_in_ty, occ_in_co) = mkOccFolders lhs_tv + lhs_tv_lvl = tcTyVarLevel lhs_tv lhs_tv_is_concrete = isConcreteTyVar lhs_tv forall_ok = case tcTyVarDetails lhs_tv of - MetaTv { mtv_info = RuntimeUnkTv } -> True - _ -> False + MetaTv { mtv_info = RuntimeUnkTv } -> True + _ -> False go (TyVarTy tv) - | lhs_tv == tv = False - | tcTyVarLevel tv > lhs_tv_lvl = False - | lhs_tv_is_concrete, not (isConcreteTyVar tv) = False - | lhs_tv `elemVarSet` tyCoVarsOfType (tyVarKind tv) = False - | otherwise = True + | lhs_tv == tv = False + | tcTyVarLevel tv > lhs_tv_lvl = False + | lhs_tv_is_concrete, not (isConcreteTyVar tv) = False + | occ_in_ty $! (tyVarKind tv) = False + | otherwise = True go (FunTy {ft_af = af, ft_mult = w, ft_arg = a, ft_res = r}) | isInvisibleFunArg af, not forall_ok = False @@ -2594,20 +2596,33 @@ simpleUnifyCheck fam_ok lhs_tv rhs | otherwise = all go tys go (AppTy t1 t2) = go t1 && go t2 - go (ForAllTy _ ty) - | forall_ok = go ty -- To be really kosher we should worry about when - -- the bound var = lhs_tv. But this only matters in the - -- GHCi debugger, and is unlikely to matter, so for now - -- I have just ignored the problem. + go (ForAllTy (Bndr tv _) ty) + | forall_ok = go (tyVarKind tv) && (tv == lhs_tv || go ty) | otherwise = False - go (CastTy ty co) = go_co co && go ty - go (CoercionTy co) = go_co co + go (CastTy ty co) = not (occ_in_co co) && go ty + go (CoercionTy co) = not (occ_in_co co) go (LitTy {}) = True - go_co co = not (lhs_tv `elemVarSet` tyCoVarsOfCo co) - && not (hasCoercionHoleCo co) +mkOccFolders :: TcTyVar -> (TcType -> Bool, TcCoercion -> Bool) +-- These functions return True +-- * if lhs_tv occurs (incl deeply, in the kind of variable) +-- * if there is a coercion hole +-- No expansion of type synonyms +mkOccFolders lhs_tv = (getAny . check_ty, getAny . check_co) + where + !(check_ty, _, check_co, _) = foldTyCo occ_folder emptyVarSet + occ_folder = TyCoFolder { tcf_view = noView -- Don't expand synonyms + , tcf_tyvar = do_tcv, tcf_covar = do_tcv + , tcf_hole = do_hole + , tcf_tycobinder = do_bndr } + + do_tcv is v = Any (not (v `elemVarSet` is) && v == lhs_tv) + `mappend` check_ty (varType v) + + do_bndr is tcv _faf = extendVarSet is tcv + do_hole _is _hole = DM.Any True -- Reject coercion holes {- ********************************************************************* * * @@ -2767,9 +2782,11 @@ mapCheck f xs -- unzipRedns :: [Reduction] -> Reductions occursCheckTv :: TcTyVar -> TcTyVar -> Bool +-- True <=> occurs-check fires occursCheckTv lhs_tv occ_tv - = lhs_tv == occ_tv - || lhs_tv `elemVarSet` tyCoVarsOfType (tyVarKind occ_tv) + = lhs_tv == occ_tv || check_kind (tyVarKind occ_tv) + where + (check_kind, _) = mkOccFolders lhs_tv ----------------------------- data TyEqFlags a @@ -2988,12 +3005,11 @@ checkTyConApp flags@(TEF { tef_unifying = unifying, tef_foralls = foralls_ok }) ; traceTc "Over-sat" (ppr tc <+> ppr tys $$ ppr arity $$ pprPur fun_res $$ pprPur extra_res) ; return (mkAppRedns <$> fun_res <*> extra_res) } - | not (isFamFreeTyCon tc) || isForgetfulSynTyCon tc + | Just ty' <- rewriterView tc_app -- e.g. S a where type S a = F [a] -- or type S a = Int -- See Note [Forgetful synonyms in checkTyConApp] - , Just ty' <- coreView tc_app -- Only synonyms and type families reply - = checkTyEqRhs flags ty' -- False to isFamFreeTyCon + = checkTyEqRhs flags ty' | not (isTauTyCon tc || foralls_ok) = failCheckWith impredicativeProblem @@ -3184,6 +3200,7 @@ touchabilityAndShapeTest :: TcLevel -> TcTyVar -> TcType -> Bool -- This is the key test for untouchability: -- See Note [Unification preconditions] in GHC.Tc.Utils.Unify -- and Note [Solve by unification] in GHC.Tc.Solver.Interact +-- True <=> touchability and shape are OK touchabilityAndShapeTest given_eq_lvl tv rhs | MetaTv { mtv_info = info, mtv_tclvl = tv_lvl } <- tcTyVarDetails tv , checkTopShape info rhs ===================================== testsuite/tests/indexed-types/should_compile/T3208b.stderr ===================================== @@ -1,6 +1,6 @@ T3208b.hs:15:10: error: [GHC-05617] - • Could not deduce ‘OTerm o0 ~ STerm a’ arising from a use of ‘fce’ + • Could not deduce ‘STerm o0 ~ OTerm a’ arising from a use of ‘fce’ from the context: (OTerm a ~ STerm a, OBJECT a, SUBST a) bound by the type signature for: fce' :: forall a c. @@ -15,7 +15,7 @@ T3208b.hs:15:10: error: [GHC-05617] fce' :: a -> c (bound at T3208b.hs:15:1) T3208b.hs:15:15: error: [GHC-05617] - • Could not deduce ‘STerm o0 ~ STerm a’ + • Could not deduce ‘OTerm o0 ~ OTerm a’ arising from a use of ‘apply’ from the context: (OTerm a ~ STerm a, OBJECT a, SUBST a) bound by the type signature for: @@ -23,7 +23,7 @@ T3208b.hs:15:15: error: [GHC-05617] (OTerm a ~ STerm a, OBJECT a, SUBST a) => a -> c at T3208b.hs:14:1-56 - NB: ‘STerm’ is a non-injective type family + NB: ‘OTerm’ is a non-injective type family The type variable ‘o0’ is ambiguous • In the first argument of ‘fce’, namely ‘(apply f)’ In the expression: fce (apply f) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1c87de83cfbff51557e7d544f78cfe71f7e812f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1c87de83cfbff51557e7d544f78cfe71f7e812f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 00:24:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 25 Mar 2023 20:24:05 -0400 Subject: [Git][ghc/ghc][master] 2 commits: rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Message-ID: <641f90a55d686_13561a23e5365c369322@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 4 changed files: - + rts/ZeroSlop.c - rts/include/Cmm.h - rts/include/rts/storage/ClosureMacros.h - rts/rts.cabal.in Changes: ===================================== rts/ZeroSlop.c ===================================== @@ -0,0 +1,27 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2012 + * + * Utilities for zeroing slop callable from Cmm + * + * N.B. If you are in C you should rather using the inlineable utilities + * (e.g. overwritingClosure) defined in ClosureMacros.h. + * + * -------------------------------------------------------------------------- */ + +#include "Rts.h" + +void stg_overwritingClosure (StgClosure *p) +{ + overwritingClosure(p); +} + +void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) +{ + overwritingMutableClosureOfs(p, offset); +} + +void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */) +{ + overwritingClosureSize(p, size); +} ===================================== rts/include/Cmm.h ===================================== @@ -647,9 +647,9 @@ #define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n)) #if defined(PROFILING) || defined(DEBUG) -#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" overwritingClosureSize(c "ptr", size) -#define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr") -#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" overwritingMutableClosureOfs(c "ptr", off) +#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" stg_overwritingClosureSize(c "ptr", size) +#define OVERWRITING_CLOSURE(c) foreign "C" stg_overwritingClosure(c "ptr") +#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" stg_overwritingMutableClosureOfs(c "ptr", off) #else #define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */ #define OVERWRITING_CLOSURE(c) /* nothing */ @@ -657,7 +657,7 @@ * this whenever profiling is enabled as described in Note [slop on the heap] * in Storage.c. */ #define OVERWRITING_CLOSURE_MUTABLE(c, off) \ - if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off); } + if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" stg_overwritingMutableClosureOfs(c "ptr", off); } #endif #define IS_STACK_CLEAN(stack) \ ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -517,16 +517,12 @@ void LDV_recordDead (const StgClosure *c, uint32_t size); RTS_PRIVATE bool isInherentlyUsed ( StgHalfWord closure_type ); #endif -EXTERN_INLINE void -zeroSlop ( - StgClosure *p, - uint32_t offset, /*< offset to start zeroing at, in words */ - uint32_t size, /*< total closure size, in words */ - bool known_mutable /*< is this a closure who's slop we can always zero? */ - ); - -EXTERN_INLINE void -zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) +INLINE_HEADER void +zeroSlop (StgClosure *p, + uint32_t offset, /*< offset to start zeroing at, in words */ + uint32_t size, /*< total closure size, in words */ + bool known_mutable /*< is this a closure who's slop we can always zero? */ + ) { // see Note [zeroing slop when overwriting closures], also #8402 @@ -539,9 +535,8 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) #endif ; - const bool can_zero_immutable_slop = - // Only if we're running single threaded. - RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1; + // Only if we're running single threaded. + const bool can_zero_immutable_slop = getNumCapabilities() == 1; const bool zero_slop_immutable = want_to_zero_immutable_slop && can_zero_immutable_slop; @@ -574,8 +569,10 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) } } -EXTERN_INLINE void overwritingClosure (StgClosure *p); -EXTERN_INLINE void overwritingClosure (StgClosure *p) +// N.B. the stg_* variants of the utilities below are only for calling from +// Cmm. The INLINE_HEADER functions should be used when in C. +void stg_overwritingClosure (StgClosure *p); +INLINE_HEADER void overwritingClosure (StgClosure *p) { W_ size = closure_sizeW(p); #if defined(PROFILING) @@ -585,15 +582,13 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p) zeroSlop(p, sizeofW(StgThunkHeader), size, /*known_mutable=*/false); } + // Version of 'overwritingClosure' which overwrites only a suffix of a // closure. The offset is expressed in words relative to 'p' and shall // be less than or equal to closure_sizeW(p), and usually at least as // large as the respective thunk header. -EXTERN_INLINE void -overwritingMutableClosureOfs (StgClosure *p, uint32_t offset); - -EXTERN_INLINE void -overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) +void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset); +INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) { // Since overwritingClosureOfs is only ever called by: // @@ -610,8 +605,8 @@ overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) } // Version of 'overwritingClosure' which takes closure size as argument. -EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size /* in words */); -EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size) +void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */); +INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size) { // This function is only called from stg_AP_STACK so we can assume it's not // inherently used. ===================================== rts/rts.cabal.in ===================================== @@ -603,6 +603,7 @@ library TSANUtils.c WSDeque.c Weak.c + ZeroSlop.c eventlog/EventLog.c eventlog/EventLogWriter.c hooks/FlagDefaults.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80729d96e47c99dc38e83612dfcfe01cf565eac0...c32abd4b936b3dfc61974ed5915c330fe7ed10d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80729d96e47c99dc38e83612dfcfe01cf565eac0...c32abd4b936b3dfc61974ed5915c330fe7ed10d5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 00:24:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 25 Mar 2023 20:24:39 -0400 Subject: [Git][ghc/ghc][master] Add Eq/Ord instances for SSymbol, SChar, and SNat Message-ID: <641f90c73398d_13561a23fc1e44373239@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 3 changed files: - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -68,7 +68,7 @@ module GHC.TypeLits ) where -import GHC.Base ( Eq(..), Functor(..), Ord(..), Ordering(..), String +import GHC.Base ( Bool(..), Eq(..), Functor(..), Ord(..), Ordering(..), String , (.), otherwise, withDict, Void, (++) , errorWithoutStackTrace) import GHC.Types(Symbol, Char, TYPE) @@ -374,6 +374,14 @@ data KnownSymbolInstance (s :: Symbol) where knownSymbolInstance :: SSymbol s -> KnownSymbolInstance s knownSymbolInstance ss = withKnownSymbol ss KnownSymbolInstance +-- | @since 4.19.0.0 +instance Eq (SSymbol s) where + _ == _ = True + +-- | @since 4.19.0.0 +instance Ord (SSymbol s) where + compare _ _ = EQ + -- | @since 4.18.0.0 instance Show (SSymbol s) where showsPrec p (UnsafeSSymbol s) @@ -467,6 +475,14 @@ data KnownCharInstance (n :: Char) where knownCharInstance :: SChar c -> KnownCharInstance c knownCharInstance sc = withKnownChar sc KnownCharInstance +-- | @since 4.19.0.0 +instance Eq (SChar c) where + _ == _ = True + +-- | @since 4.19.0.0 +instance Ord (SChar c) where + compare _ _ = EQ + -- | @since 4.18.0.0 instance Show (SChar c) where showsPrec p (UnsafeSChar c) ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -378,6 +378,14 @@ data KnownNatInstance (n :: Nat) where knownNatInstance :: SNat n -> KnownNatInstance n knownNatInstance sn = withKnownNat sn KnownNatInstance +-- | @since 4.19.0.0 +instance Eq (SNat n) where + _ == _ = True + +-- | @since 4.19.0.0 +instance Ord (SNat n) where + compare _ _ = EQ + -- | @since 4.18.0.0 instance Show (SNat n) where showsPrec p (UnsafeSNat n) ===================================== libraries/base/changelog.md ===================================== @@ -14,6 +14,8 @@ * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) * Implement more members of `instance Foldable (Compose f g)` explicitly. ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) + * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. + ([CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148)) ## 4.18.0.0 *TBA* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/656d4cb3e3a450ececcc72ffd2aca6f8e6489102 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/656d4cb3e3a450ececcc72ffd2aca6f8e6489102 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 00:30:44 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Sat, 25 Mar 2023 20:30:44 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/clc-149 Message-ID: <641f9234b8610_13561a240bc0383735f@gitlab.mail> Ryan Scott pushed new branch wip/clc-149 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/clc-149 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 00:32:35 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Sat, 25 Mar 2023 20:32:35 -0400 Subject: [Git][ghc/ghc][wip/clc-149] 4 commits: rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Message-ID: <641f92a3ad73_13561a23ccd51c3756bf@gitlab.mail> Ryan Scott pushed to branch wip/clc-149 at Glasgow Haskell Compiler / GHC Commits: c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 56656954 by Ryan Scott at 2023-03-25T20:32:19-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 10 changed files: - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/changelog.md - + libraries/base/tests/CLC149.hs - libraries/base/tests/all.T - + rts/ZeroSlop.c - rts/include/Cmm.h - rts/include/rts/storage/ClosureMacros.h - rts/rts.cabal.in Changes: ===================================== libraries/base/Data/Typeable/Internal.hs ===================================== @@ -272,6 +272,7 @@ typeableInstance rep = withTypeable rep TypeableInstance pattern TypeRep :: forall {k :: Type} (a :: k). () => Typeable @k a => TypeRep @k a pattern TypeRep <- (typeableInstance -> TypeableInstance) where TypeRep = typeRep +{-# COMPLETE TypeRep #-} {- Note [TypeRep fingerprints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -68,7 +68,7 @@ module GHC.TypeLits ) where -import GHC.Base ( Eq(..), Functor(..), Ord(..), Ordering(..), String +import GHC.Base ( Bool(..), Eq(..), Functor(..), Ord(..), Ordering(..), String , (.), otherwise, withDict, Void, (++) , errorWithoutStackTrace) import GHC.Types(Symbol, Char, TYPE) @@ -363,6 +363,7 @@ newtype SSymbol (s :: Symbol) = UnsafeSSymbol String pattern SSymbol :: forall s. () => KnownSymbol s => SSymbol s pattern SSymbol <- (knownSymbolInstance -> KnownSymbolInstance) where SSymbol = symbolSing +{-# COMPLETE SSymbol #-} -- An internal data type that is only used for defining the SSymbol pattern -- synonym. @@ -374,6 +375,14 @@ data KnownSymbolInstance (s :: Symbol) where knownSymbolInstance :: SSymbol s -> KnownSymbolInstance s knownSymbolInstance ss = withKnownSymbol ss KnownSymbolInstance +-- | @since 4.19.0.0 +instance Eq (SSymbol s) where + _ == _ = True + +-- | @since 4.19.0.0 +instance Ord (SSymbol s) where + compare _ _ = EQ + -- | @since 4.18.0.0 instance Show (SSymbol s) where showsPrec p (UnsafeSSymbol s) @@ -456,6 +465,7 @@ newtype SChar (s :: Char) = UnsafeSChar Char pattern SChar :: forall c. () => KnownChar c => SChar c pattern SChar <- (knownCharInstance -> KnownCharInstance) where SChar = charSing +{-# COMPLETE SChar #-} -- An internal data type that is only used for defining the SChar pattern -- synonym. @@ -467,6 +477,14 @@ data KnownCharInstance (n :: Char) where knownCharInstance :: SChar c -> KnownCharInstance c knownCharInstance sc = withKnownChar sc KnownCharInstance +-- | @since 4.19.0.0 +instance Eq (SChar c) where + _ == _ = True + +-- | @since 4.19.0.0 +instance Ord (SChar c) where + compare _ _ = EQ + -- | @since 4.18.0.0 instance Show (SChar c) where showsPrec p (UnsafeSChar c) ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -367,6 +367,7 @@ newtype SNat (n :: Nat) = UnsafeSNat Natural pattern SNat :: forall n. () => KnownNat n => SNat n pattern SNat <- (knownNatInstance -> KnownNatInstance) where SNat = natSing +{-# COMPLETE SNat #-} -- An internal data type that is only used for defining the SNat pattern -- synonym. @@ -378,6 +379,14 @@ data KnownNatInstance (n :: Nat) where knownNatInstance :: SNat n -> KnownNatInstance n knownNatInstance sn = withKnownNat sn KnownNatInstance +-- | @since 4.19.0.0 +instance Eq (SNat n) where + _ == _ = True + +-- | @since 4.19.0.0 +instance Ord (SNat n) where + compare _ _ = EQ + -- | @since 4.18.0.0 instance Show (SNat n) where showsPrec p (UnsafeSNat n) ===================================== libraries/base/changelog.md ===================================== @@ -14,6 +14,10 @@ * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) * Implement more members of `instance Foldable (Compose f g)` explicitly. ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) + * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. + ([CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148)) + * Add `COMPLETE` pragmas to the `TypeRep`, `SSymbol`, `SChar`, and `SNat` pattern synonyms. + ([CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149)) ## 4.18.0.0 *TBA* * Shipped with GHC 9.6.1 ===================================== libraries/base/tests/CLC149.hs ===================================== @@ -0,0 +1,23 @@ +-- Test the COMPLETE pragmas for SChar, SNat, SSymbol, and TypeRep. +{-# OPTIONS_GHC -Wincomplete-patterns #-} +module CLC149 where + +import Data.Kind +import GHC.TypeLits +import Type.Reflection + +type Dict :: Constraint -> Type +data Dict c where + Dict :: c => Dict c + +sc :: SChar c -> Dict (KnownChar c) +sc SChar = Dict + +sn :: SNat n -> Dict (KnownNat n) +sn SNat = Dict + +ss :: SSymbol s -> Dict (KnownSymbol s) +ss SSymbol = Dict + +tr :: TypeRep a -> Dict (Typeable a) +tr TypeRep = Dict ===================================== libraries/base/tests/all.T ===================================== @@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('CLC149', normal, compile, ['']) ===================================== rts/ZeroSlop.c ===================================== @@ -0,0 +1,27 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2012 + * + * Utilities for zeroing slop callable from Cmm + * + * N.B. If you are in C you should rather using the inlineable utilities + * (e.g. overwritingClosure) defined in ClosureMacros.h. + * + * -------------------------------------------------------------------------- */ + +#include "Rts.h" + +void stg_overwritingClosure (StgClosure *p) +{ + overwritingClosure(p); +} + +void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) +{ + overwritingMutableClosureOfs(p, offset); +} + +void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */) +{ + overwritingClosureSize(p, size); +} ===================================== rts/include/Cmm.h ===================================== @@ -647,9 +647,9 @@ #define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n)) #if defined(PROFILING) || defined(DEBUG) -#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" overwritingClosureSize(c "ptr", size) -#define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr") -#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" overwritingMutableClosureOfs(c "ptr", off) +#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" stg_overwritingClosureSize(c "ptr", size) +#define OVERWRITING_CLOSURE(c) foreign "C" stg_overwritingClosure(c "ptr") +#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" stg_overwritingMutableClosureOfs(c "ptr", off) #else #define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */ #define OVERWRITING_CLOSURE(c) /* nothing */ @@ -657,7 +657,7 @@ * this whenever profiling is enabled as described in Note [slop on the heap] * in Storage.c. */ #define OVERWRITING_CLOSURE_MUTABLE(c, off) \ - if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off); } + if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" stg_overwritingMutableClosureOfs(c "ptr", off); } #endif #define IS_STACK_CLEAN(stack) \ ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -517,16 +517,12 @@ void LDV_recordDead (const StgClosure *c, uint32_t size); RTS_PRIVATE bool isInherentlyUsed ( StgHalfWord closure_type ); #endif -EXTERN_INLINE void -zeroSlop ( - StgClosure *p, - uint32_t offset, /*< offset to start zeroing at, in words */ - uint32_t size, /*< total closure size, in words */ - bool known_mutable /*< is this a closure who's slop we can always zero? */ - ); - -EXTERN_INLINE void -zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) +INLINE_HEADER void +zeroSlop (StgClosure *p, + uint32_t offset, /*< offset to start zeroing at, in words */ + uint32_t size, /*< total closure size, in words */ + bool known_mutable /*< is this a closure who's slop we can always zero? */ + ) { // see Note [zeroing slop when overwriting closures], also #8402 @@ -539,9 +535,8 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) #endif ; - const bool can_zero_immutable_slop = - // Only if we're running single threaded. - RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1; + // Only if we're running single threaded. + const bool can_zero_immutable_slop = getNumCapabilities() == 1; const bool zero_slop_immutable = want_to_zero_immutable_slop && can_zero_immutable_slop; @@ -574,8 +569,10 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) } } -EXTERN_INLINE void overwritingClosure (StgClosure *p); -EXTERN_INLINE void overwritingClosure (StgClosure *p) +// N.B. the stg_* variants of the utilities below are only for calling from +// Cmm. The INLINE_HEADER functions should be used when in C. +void stg_overwritingClosure (StgClosure *p); +INLINE_HEADER void overwritingClosure (StgClosure *p) { W_ size = closure_sizeW(p); #if defined(PROFILING) @@ -585,15 +582,13 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p) zeroSlop(p, sizeofW(StgThunkHeader), size, /*known_mutable=*/false); } + // Version of 'overwritingClosure' which overwrites only a suffix of a // closure. The offset is expressed in words relative to 'p' and shall // be less than or equal to closure_sizeW(p), and usually at least as // large as the respective thunk header. -EXTERN_INLINE void -overwritingMutableClosureOfs (StgClosure *p, uint32_t offset); - -EXTERN_INLINE void -overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) +void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset); +INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) { // Since overwritingClosureOfs is only ever called by: // @@ -610,8 +605,8 @@ overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) } // Version of 'overwritingClosure' which takes closure size as argument. -EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size /* in words */); -EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size) +void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */); +INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size) { // This function is only called from stg_AP_STACK so we can assume it's not // inherently used. ===================================== rts/rts.cabal.in ===================================== @@ -603,6 +603,7 @@ library TSANUtils.c WSDeque.c Weak.c + ZeroSlop.c eventlog/EventLog.c eventlog/EventLogWriter.c hooks/FlagDefaults.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28b67c5f621a1d292e54b9819cf329fbcf7a74fd...56656954bc12efee009c9c0739e9e67153706379 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28b67c5f621a1d292e54b9819cf329fbcf7a74fd...56656954bc12efee009c9c0739e9e67153706379 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 03:39:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 25 Mar 2023 23:39:06 -0400 Subject: [Git][ghc/ghc][wip/rts-warnings] hihi Message-ID: <641fbe5ae057b_13561a274783b83805b6@gitlab.mail> Ben Gamari pushed to branch wip/rts-warnings at Glasgow Haskell Compiler / GHC Commits: b9e7a8e0 by Ben Gamari at 2023-03-25T23:39:01-04:00 hihi - - - - - 1 changed file: - rts/sm/NonMovingMark.c Changes: ===================================== rts/sm/NonMovingMark.c ===================================== @@ -39,9 +39,7 @@ static void trace_PAP_payload (MarkQueue *queue, StgClosure *fun, StgClosure **payload, StgWord size); -#if defined(DEBUG) static bool is_nonmoving_weak(StgWeak *weak); -#endif // How many Array# entries to add to the mark queue at once? #define MARK_ARRAY_CHUNK_LENGTH 128 @@ -1968,7 +1966,6 @@ void nonmovingMarkWeakPtrList (struct MarkQueue_ *queue) // Determine whether a weak pointer object is on one of the nonmoving // collector's weak pointer lists. Used for sanity checking. -#if defined(DEBUG) static bool is_nonmoving_weak(StgWeak *weak) { for (StgWeak *w = nonmoving_old_weak_ptr_list; w != NULL; w = w->link) { @@ -1979,7 +1976,6 @@ static bool is_nonmoving_weak(StgWeak *weak) } return false; } -#endif // Non-moving heap variant of `tidyWeakList` bool nonmovingTidyWeaks (struct MarkQueue_ *queue) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9e7a8e0a248ab433633b9751fcbaef9ce51c159 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9e7a8e0a248ab433633b9751fcbaef9ce51c159 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 03:48:01 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 25 Mar 2023 23:48:01 -0400 Subject: [Git][ghc/ghc][wip/T13660] 34 commits: DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) Message-ID: <641fc07157018_13561a27a23114381395@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 3ebaff02 by Ben Gamari at 2023-03-25T23:39:39-04:00 base: Add test for #13660 - - - - - 1ed35ec8 by Ben Gamari at 2023-03-25T23:47:56-04:00 base: Ensure that POSIX FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. Fixes #13660 on POSIX platforms. - - - - - d641c7db by Ben Gamari at 2023-03-25T23:47:56-04:00 base: Reject NUL codepoints in Windows FilePaths Similarly to POSIX, Windows rejects NULs in FilePaths. Unlike POSIX, we can check the `FilePath` rather than its encoding since all paths are UTF-16 on Windows. Fixes #13660 on Windows. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToJS/Linker/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Instance/Class.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e316cbba1e70ce1974498e2a48f89212b814d33d...d641c7db81c4ecf07f0d6a82218bb6d93d40b450 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e316cbba1e70ce1974498e2a48f89212b814d33d...d641c7db81c4ecf07f0d6a82218bb6d93d40b450 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 03:50:07 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 25 Mar 2023 23:50:07 -0400 Subject: [Git][ghc/ghc][wip/T13660] base: Reject NUL codepoints in Windows FilePaths Message-ID: <641fc0efe0a1c_13561a27c032043837dc@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 346f1039 by Ben Gamari at 2023-03-25T23:50:01-04:00 base: Reject NUL codepoints in Windows FilePaths Similarly to POSIX, Windows rejects NULs in FilePaths. Unlike POSIX, we can check the `FilePath` rather than its encoding since all paths are UTF-16 on Windows. Fixes #13660 on Windows. - - - - - 1 changed file: - libraries/base/System/Posix/Internals.hs Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -164,13 +164,32 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls fp = when ('\0' `elem` fp) (ioError err) + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "Windows filepaths must not contain internal NUL codepoints." + , ioe_errno = Nothing + , ioe_filename = Just fp + } #else withFilePath :: FilePath -> (CString -> IO a) -> IO a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/346f103916e49a2c1cb982729ff419dbe86ea9e6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/346f103916e49a2c1cb982729ff419dbe86ea9e6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 05:45:26 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Sun, 26 Mar 2023 01:45:26 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/clc-87 Message-ID: <641fdbf69e80_13561a29782b743920fd@gitlab.mail> Melanie Brown pushed new branch wip/clc-87 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/clc-87 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 05:47:08 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Sun, 26 Mar 2023 01:47:08 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/clc-87 Message-ID: <641fdc5c3784d_13561a29612b90392259@gitlab.mail> Melanie Brown deleted branch wip/clc-87 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 05:47:32 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Sun, 26 Mar 2023 01:47:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/clc-86 Message-ID: <641fdc743ece8_13561a2947a40439246d@gitlab.mail> Melanie Brown pushed new branch wip/clc-86 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/clc-86 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 05:51:53 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Sun, 26 Mar 2023 01:51:53 -0400 Subject: [Git][ghc/ghc][wip/clc-86] fix link Message-ID: <641fdd79d60a8_13561a29d42ed83944f1@gitlab.mail> Melanie Brown pushed to branch wip/clc-86 at Glasgow Haskell Compiler / GHC Commits: 3da8defa by Melanie Phoenix at 2023-03-26T01:51:50-04:00 fix link - - - - - 1 changed file: - libraries/base/changelog.md Changes: ===================================== libraries/base/changelog.md ===================================== @@ -16,7 +16,7 @@ ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. ([CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148)) - * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #87](https://github.com/haskell/core-libraries-committee/issues/87)) + * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) ## 4.18.0.0 *TBA* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3da8defaafb5de0993d5fb2a95225204e3a289cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3da8defaafb5de0993d5fb2a95225204e3a289cf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 13:27:39 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 26 Mar 2023 09:27:39 -0400 Subject: [Git][ghc/ghc][wip/T13660] base: Ensure that POSIX FilePaths don't contain NULs Message-ID: <6420484ba9f6d_13561a30dce0804193d8@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 95a3e3a2 by Ben Gamari at 2023-03-26T09:27:23-04:00 base: Ensure that POSIX FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. Fixes #13660. - - - - - 1 changed file: - libraries/base/System/Posix/Internals.hs Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -164,13 +164,22 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls s = when ('\0' `elem` s) throwInternalNulError #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,13 +187,41 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = + when (cstringLen# str /= len) throwInternlNulError + -- N.B. If the string contains internal NUL codeunits then the strlen will + -- indicate a size smaller than that returned by withCStringLen. #endif +throwInternalNulError :: IOError +throwInternalNulError = ioError err + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "FilePaths must not contain internal NUL code units." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + -- --------------------------------------------------------------------------- -- Terminal-related stuff View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95a3e3a2738f0a75e373652a9e524693d4e3cd6f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95a3e3a2738f0a75e373652a9e524693d4e3cd6f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 13:34:35 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Sun, 26 Mar 2023 09:34:35 -0400 Subject: [Git][ghc/ghc][wip/clc-86] only base commits Message-ID: <642049eb7ec48_13561a30fa5d544216b8@gitlab.mail> Melanie Brown pushed to branch wip/clc-86 at Glasgow Haskell Compiler / GHC Commits: 092658a3 by Melanie Phoenix at 2023-03-26T09:34:19-04:00 only base commits - - - - - 2 changed files: - libraries/base/Data/List/NonEmpty.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/Data/List/NonEmpty.hs ===================================== @@ -472,6 +472,7 @@ zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys -- | The 'unzip' function is the inverse of the 'zip' function. unzip :: Functor f => f (a,b) -> (f a, f b) unzip xs = (fst <$> xs, snd <$> xs) +{-# DEPRECATED unzip "This function will be made monomorphic in GHC 9.14, consider switching to Data.Functor.unzip" #-} -- | The 'nub' function removes duplicate elements from a list. In -- particular, it keeps only the first occurrence of each element. ===================================== libraries/base/changelog.md ===================================== @@ -16,6 +16,7 @@ ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. ([CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148)) + * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) ## 4.18.0.0 *TBA* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/092658a355608041c329b77a964183fe726c30b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/092658a355608041c329b77a964183fe726c30b2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 13:36:33 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Sun, 26 Mar 2023 09:36:33 -0400 Subject: [Git][ghc/ghc][wip/clc-86] mention base version Message-ID: <64204a611b6f4_13561a312e3da442217f@gitlab.mail> Melanie Brown pushed to branch wip/clc-86 at Glasgow Haskell Compiler / GHC Commits: 2bb49bce by Melanie Phoenix at 2023-03-26T09:36:23-04:00 mention base version - - - - - 1 changed file: - libraries/base/Data/List/NonEmpty.hs Changes: ===================================== libraries/base/Data/List/NonEmpty.hs ===================================== @@ -472,7 +472,7 @@ zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys -- | The 'unzip' function is the inverse of the 'zip' function. unzip :: Functor f => f (a,b) -> (f a, f b) unzip xs = (fst <$> xs, snd <$> xs) -{-# DEPRECATED unzip "This function will be made monomorphic in GHC 9.14, consider switching to Data.Functor.unzip" #-} +{-# DEPRECATED unzip "This function will be made monomorphic in base-4.22, consider switching to Data.Functor.unzip" #-} -- | The 'nub' function removes duplicate elements from a list. In -- particular, it keeps only the first occurrence of each element. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2bb49bce3a1651591bdfbfb6703c20189bcfee61 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2bb49bce3a1651591bdfbfb6703c20189bcfee61 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 14:02:35 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 26 Mar 2023 10:02:35 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Message-ID: <6420507bd3c72_13561a31644f5c42744e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 32f64f6d by David Feuer at 2023-03-26T10:02:25-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - 31e40fdf by David Feuer at 2023-03-26T10:02:29-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - 10 changed files: - libraries/base/Data/Data.hs - libraries/base/Data/IORef.hs - libraries/base/GHC/IORef.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/changelog.md - + rts/ZeroSlop.c - rts/include/Cmm.h - rts/include/rts/storage/ClosureMacros.h - rts/rts.cabal.in Changes: ===================================== libraries/base/Data/Data.hs ===================================== @@ -1136,7 +1136,10 @@ consConstr = mkConstr listDataType "(:)" [] Infix listDataType :: DataType listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr] --- | @since 4.0.0.0 +-- | For historical reasons, the constructor name used for @(:)@ is +-- @"(:)"@. In a derived instance, it would be @":"@. +-- +-- @since 4.0.0.0 instance Data a => Data [a] where gfoldl _ z [] = z [] gfoldl f z (x:xs) = z (:) `f` x `f` xs ===================================== libraries/base/Data/IORef.hs ===================================== @@ -85,21 +85,45 @@ modifyIORef' ref f = do -- is recommended that if you need to do anything more complicated -- then using 'Control.Concurrent.MVar.MVar' instead is a good idea. -- --- 'atomicModifyIORef' does not apply the function strictly. This is important --- to know even if all you are doing is replacing the value. For example, this --- will leak memory: +-- Conceptually, -- --- >ref <- newIORef '1' --- >forever $ atomicModifyIORef ref (\_ -> ('2', ())) +-- @ +-- atomicModifyIORef ref f = do +-- -- Begin atomic block +-- old <- 'readIORef' ref +-- let r = f old +-- new = fst r +-- 'writeIORef' ref new +-- -- End atomic block +-- case r of +-- (_new, res) -> pure res +-- @ -- --- Use 'atomicModifyIORef'' or 'atomicWriteIORef' to avoid this problem. +-- The actions in the section labeled \"atomic block\" are not subject to +-- interference from other threads. In particular, it is impossible for the +-- value in the 'IORef' to change between the 'readIORef' and 'writeIORef' +-- invocations. -- --- This function imposes a memory barrier, preventing reordering; --- see "Data.IORef#memmodel" for details. +-- The user-supplied function is applied to the value stored in the 'IORef', +-- yielding a new value to store in the 'IORef' and a value to return. After +-- the new value is (lazily) stored in the 'IORef', @atomicModifyIORef@ forces +-- the result pair, but does not force either component of the result. To force +-- /both/ components, use 'atomicModifyIORef''. +-- +-- Note that +-- +-- @atomicModifyIORef ref (\_ -> undefined)@ +-- +-- will raise an exception in the calling thread, but will /also/ +-- install the bottoming value in the 'IORef', where it may be read by +-- other threads. +-- +-- This function imposes a memory barrier, preventing reordering around the +-- \"atomic block\"; see "Data.IORef#memmodel" for details. -- atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b atomicModifyIORef ref f = do - (_old, ~(_new, res)) <- atomicModifyIORef2 ref f + (_old, (_new, res)) <- atomicModifyIORef2 ref f pure res -- | Variant of 'writeIORef'. The prefix "atomic" relates to a fact that ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -134,9 +134,28 @@ atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> data Box a = Box a --- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both --- the value stored in the 'IORef' and the value returned. The new value --- is installed in the 'IORef' before the returned value is forced. +-- | A strict version of 'Data.IORef.atomicModifyIORef'. This forces both the +-- value stored in the 'IORef' and the value returned. +-- +-- Conceptually, +-- +-- @ +-- atomicModifyIORef' ref f = do +-- -- Begin atomic block +-- old <- 'readIORef' ref +-- let r = f old +-- new = fst r +-- 'writeIORef' ref new +-- -- End atomic block +-- case r of +-- (!_new, !res) -> pure res +-- @ +-- +-- The actions in the \"atomic block\" are not subject to interference +-- by other threads. In particular, the value in the 'IORef' cannot +-- change between the 'readIORef' and 'writeIORef' invocations. +-- +-- The new value is installed in the 'IORef' before either value is forced. -- So -- -- @atomicModifyIORef' ref (\x -> (x+1, undefined))@ @@ -144,8 +163,18 @@ data Box a = Box a -- will increment the 'IORef' and then throw an exception in the calling -- thread. -- --- This function imposes a memory barrier, preventing reordering; --- see "Data.IORef#memmodel" for details. +-- @atomicModifyIORef' ref (\x -> (undefined, x))@ +-- +-- and +-- +-- @atomicModifyIORef' ref (\_ -> undefined)@ +-- +-- will each raise an exception in the calling thread, but will /also/ +-- install the bottoming value in the 'IORef', where it may be read by +-- other threads. +-- +-- This function imposes a memory barrier, preventing reordering around +-- the \"atomic block\"; see "Data.IORef#memmodel" for details. -- -- @since 4.6.0.0 atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -68,7 +68,7 @@ module GHC.TypeLits ) where -import GHC.Base ( Eq(..), Functor(..), Ord(..), Ordering(..), String +import GHC.Base ( Bool(..), Eq(..), Functor(..), Ord(..), Ordering(..), String , (.), otherwise, withDict, Void, (++) , errorWithoutStackTrace) import GHC.Types(Symbol, Char, TYPE) @@ -374,6 +374,14 @@ data KnownSymbolInstance (s :: Symbol) where knownSymbolInstance :: SSymbol s -> KnownSymbolInstance s knownSymbolInstance ss = withKnownSymbol ss KnownSymbolInstance +-- | @since 4.19.0.0 +instance Eq (SSymbol s) where + _ == _ = True + +-- | @since 4.19.0.0 +instance Ord (SSymbol s) where + compare _ _ = EQ + -- | @since 4.18.0.0 instance Show (SSymbol s) where showsPrec p (UnsafeSSymbol s) @@ -467,6 +475,14 @@ data KnownCharInstance (n :: Char) where knownCharInstance :: SChar c -> KnownCharInstance c knownCharInstance sc = withKnownChar sc KnownCharInstance +-- | @since 4.19.0.0 +instance Eq (SChar c) where + _ == _ = True + +-- | @since 4.19.0.0 +instance Ord (SChar c) where + compare _ _ = EQ + -- | @since 4.18.0.0 instance Show (SChar c) where showsPrec p (UnsafeSChar c) ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -378,6 +378,14 @@ data KnownNatInstance (n :: Nat) where knownNatInstance :: SNat n -> KnownNatInstance n knownNatInstance sn = withKnownNat sn KnownNatInstance +-- | @since 4.19.0.0 +instance Eq (SNat n) where + _ == _ = True + +-- | @since 4.19.0.0 +instance Ord (SNat n) where + compare _ _ = EQ + -- | @since 4.18.0.0 instance Show (SNat n) where showsPrec p (UnsafeSNat n) ===================================== libraries/base/changelog.md ===================================== @@ -14,6 +14,8 @@ * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88)) * Implement more members of `instance Foldable (Compose f g)` explicitly. ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) + * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. + ([CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148)) ## 4.18.0.0 *TBA* * Shipped with GHC 9.6.1 ===================================== rts/ZeroSlop.c ===================================== @@ -0,0 +1,27 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2012 + * + * Utilities for zeroing slop callable from Cmm + * + * N.B. If you are in C you should rather using the inlineable utilities + * (e.g. overwritingClosure) defined in ClosureMacros.h. + * + * -------------------------------------------------------------------------- */ + +#include "Rts.h" + +void stg_overwritingClosure (StgClosure *p) +{ + overwritingClosure(p); +} + +void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) +{ + overwritingMutableClosureOfs(p, offset); +} + +void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */) +{ + overwritingClosureSize(p, size); +} ===================================== rts/include/Cmm.h ===================================== @@ -647,9 +647,9 @@ #define mutArrPtrsCardWords(n) ROUNDUP_BYTES_TO_WDS(mutArrPtrCardUp(n)) #if defined(PROFILING) || defined(DEBUG) -#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" overwritingClosureSize(c "ptr", size) -#define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr") -#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" overwritingMutableClosureOfs(c "ptr", off) +#define OVERWRITING_CLOSURE_SIZE(c, size) foreign "C" stg_overwritingClosureSize(c "ptr", size) +#define OVERWRITING_CLOSURE(c) foreign "C" stg_overwritingClosure(c "ptr") +#define OVERWRITING_CLOSURE_MUTABLE(c, off) foreign "C" stg_overwritingMutableClosureOfs(c "ptr", off) #else #define OVERWRITING_CLOSURE_SIZE(c, size) /* nothing */ #define OVERWRITING_CLOSURE(c) /* nothing */ @@ -657,7 +657,7 @@ * this whenever profiling is enabled as described in Note [slop on the heap] * in Storage.c. */ #define OVERWRITING_CLOSURE_MUTABLE(c, off) \ - if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" overwritingMutableClosureOfs(c "ptr", off); } + if (TO_W_(RtsFlags_ProfFlags_doHeapProfile(RtsFlags)) != 0) { foreign "C" stg_overwritingMutableClosureOfs(c "ptr", off); } #endif #define IS_STACK_CLEAN(stack) \ ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -517,16 +517,12 @@ void LDV_recordDead (const StgClosure *c, uint32_t size); RTS_PRIVATE bool isInherentlyUsed ( StgHalfWord closure_type ); #endif -EXTERN_INLINE void -zeroSlop ( - StgClosure *p, - uint32_t offset, /*< offset to start zeroing at, in words */ - uint32_t size, /*< total closure size, in words */ - bool known_mutable /*< is this a closure who's slop we can always zero? */ - ); - -EXTERN_INLINE void -zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) +INLINE_HEADER void +zeroSlop (StgClosure *p, + uint32_t offset, /*< offset to start zeroing at, in words */ + uint32_t size, /*< total closure size, in words */ + bool known_mutable /*< is this a closure who's slop we can always zero? */ + ) { // see Note [zeroing slop when overwriting closures], also #8402 @@ -539,9 +535,8 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) #endif ; - const bool can_zero_immutable_slop = - // Only if we're running single threaded. - RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1; + // Only if we're running single threaded. + const bool can_zero_immutable_slop = getNumCapabilities() == 1; const bool zero_slop_immutable = want_to_zero_immutable_slop && can_zero_immutable_slop; @@ -574,8 +569,10 @@ zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable) } } -EXTERN_INLINE void overwritingClosure (StgClosure *p); -EXTERN_INLINE void overwritingClosure (StgClosure *p) +// N.B. the stg_* variants of the utilities below are only for calling from +// Cmm. The INLINE_HEADER functions should be used when in C. +void stg_overwritingClosure (StgClosure *p); +INLINE_HEADER void overwritingClosure (StgClosure *p) { W_ size = closure_sizeW(p); #if defined(PROFILING) @@ -585,15 +582,13 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p) zeroSlop(p, sizeofW(StgThunkHeader), size, /*known_mutable=*/false); } + // Version of 'overwritingClosure' which overwrites only a suffix of a // closure. The offset is expressed in words relative to 'p' and shall // be less than or equal to closure_sizeW(p), and usually at least as // large as the respective thunk header. -EXTERN_INLINE void -overwritingMutableClosureOfs (StgClosure *p, uint32_t offset); - -EXTERN_INLINE void -overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) +void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset); +INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) { // Since overwritingClosureOfs is only ever called by: // @@ -610,8 +605,8 @@ overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) } // Version of 'overwritingClosure' which takes closure size as argument. -EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size /* in words */); -EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size) +void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */); +INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size) { // This function is only called from stg_AP_STACK so we can assume it's not // inherently used. ===================================== rts/rts.cabal.in ===================================== @@ -603,6 +603,7 @@ library TSANUtils.c WSDeque.c Weak.c + ZeroSlop.c eventlog/EventLog.c eventlog/EventLogWriter.c hooks/FlagDefaults.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/981adc5123f4763aab0c06e51990ced8d3e37071...31e40fdf2ed3f56f710afe96da7db1ed7b4e21cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/981adc5123f4763aab0c06e51990ced8d3e37071...31e40fdf2ed3f56f710afe96da7db1ed7b4e21cb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 14:34:36 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Sun, 26 Mar 2023 10:34:36 -0400 Subject: [Git][ghc/ghc][wip/clc-86] Deprecate Data.List.NonEmpty.unzip Message-ID: <642057fcdc40a_13561a31df330c43388e@gitlab.mail> Melanie Brown pushed to branch wip/clc-86 at Glasgow Haskell Compiler / GHC Commits: 294f2101 by Melanie Phoenix at 2023-03-26T10:34:09-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 2 changed files: - libraries/base/Data/List/NonEmpty.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/Data/List/NonEmpty.hs ===================================== @@ -472,6 +472,7 @@ zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys -- | The 'unzip' function is the inverse of the 'zip' function. unzip :: Functor f => f (a,b) -> (f a, f b) unzip xs = (fst <$> xs, snd <$> xs) +{-# DEPRECATED unzip "This function will be made monomorphic in base-4.22, consider switching to Data.Functor.unzip" #-} -- | The 'nub' function removes duplicate elements from a list. In -- particular, it keeps only the first occurrence of each element. ===================================== libraries/base/changelog.md ===================================== @@ -16,6 +16,7 @@ ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. ([CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148)) + * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) ## 4.18.0.0 *TBA* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/294f2101d3f93b60e881bab2efada73f9dd35c89 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/294f2101d3f93b60e881bab2efada73f9dd35c89 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 17:02:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 26 Mar 2023 13:02:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Update and expand atomic modification Haddocks Message-ID: <64207ac23966c_13561a348efefc4491e2@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 17371c5b by David Feuer at 2023-03-26T13:02:50-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - 7281d5aa by David Feuer at 2023-03-26T13:02:54-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - 3 changed files: - libraries/base/Data/Data.hs - libraries/base/Data/IORef.hs - libraries/base/GHC/IORef.hs Changes: ===================================== libraries/base/Data/Data.hs ===================================== @@ -1136,7 +1136,10 @@ consConstr = mkConstr listDataType "(:)" [] Infix listDataType :: DataType listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr] --- | @since 4.0.0.0 +-- | For historical reasons, the constructor name used for @(:)@ is +-- @"(:)"@. In a derived instance, it would be @":"@. +-- +-- @since 4.0.0.0 instance Data a => Data [a] where gfoldl _ z [] = z [] gfoldl f z (x:xs) = z (:) `f` x `f` xs ===================================== libraries/base/Data/IORef.hs ===================================== @@ -85,21 +85,45 @@ modifyIORef' ref f = do -- is recommended that if you need to do anything more complicated -- then using 'Control.Concurrent.MVar.MVar' instead is a good idea. -- --- 'atomicModifyIORef' does not apply the function strictly. This is important --- to know even if all you are doing is replacing the value. For example, this --- will leak memory: +-- Conceptually, -- --- >ref <- newIORef '1' --- >forever $ atomicModifyIORef ref (\_ -> ('2', ())) +-- @ +-- atomicModifyIORef ref f = do +-- -- Begin atomic block +-- old <- 'readIORef' ref +-- let r = f old +-- new = fst r +-- 'writeIORef' ref new +-- -- End atomic block +-- case r of +-- (_new, res) -> pure res +-- @ -- --- Use 'atomicModifyIORef'' or 'atomicWriteIORef' to avoid this problem. +-- The actions in the section labeled \"atomic block\" are not subject to +-- interference from other threads. In particular, it is impossible for the +-- value in the 'IORef' to change between the 'readIORef' and 'writeIORef' +-- invocations. -- --- This function imposes a memory barrier, preventing reordering; --- see "Data.IORef#memmodel" for details. +-- The user-supplied function is applied to the value stored in the 'IORef', +-- yielding a new value to store in the 'IORef' and a value to return. After +-- the new value is (lazily) stored in the 'IORef', @atomicModifyIORef@ forces +-- the result pair, but does not force either component of the result. To force +-- /both/ components, use 'atomicModifyIORef''. +-- +-- Note that +-- +-- @atomicModifyIORef ref (\_ -> undefined)@ +-- +-- will raise an exception in the calling thread, but will /also/ +-- install the bottoming value in the 'IORef', where it may be read by +-- other threads. +-- +-- This function imposes a memory barrier, preventing reordering around the +-- \"atomic block\"; see "Data.IORef#memmodel" for details. -- atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b atomicModifyIORef ref f = do - (_old, ~(_new, res)) <- atomicModifyIORef2 ref f + (_old, (_new, res)) <- atomicModifyIORef2 ref f pure res -- | Variant of 'writeIORef'. The prefix "atomic" relates to a fact that ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -134,9 +134,28 @@ atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> data Box a = Box a --- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both --- the value stored in the 'IORef' and the value returned. The new value --- is installed in the 'IORef' before the returned value is forced. +-- | A strict version of 'Data.IORef.atomicModifyIORef'. This forces both the +-- value stored in the 'IORef' and the value returned. +-- +-- Conceptually, +-- +-- @ +-- atomicModifyIORef' ref f = do +-- -- Begin atomic block +-- old <- 'readIORef' ref +-- let r = f old +-- new = fst r +-- 'writeIORef' ref new +-- -- End atomic block +-- case r of +-- (!_new, !res) -> pure res +-- @ +-- +-- The actions in the \"atomic block\" are not subject to interference +-- by other threads. In particular, the value in the 'IORef' cannot +-- change between the 'readIORef' and 'writeIORef' invocations. +-- +-- The new value is installed in the 'IORef' before either value is forced. -- So -- -- @atomicModifyIORef' ref (\x -> (x+1, undefined))@ @@ -144,8 +163,18 @@ data Box a = Box a -- will increment the 'IORef' and then throw an exception in the calling -- thread. -- --- This function imposes a memory barrier, preventing reordering; --- see "Data.IORef#memmodel" for details. +-- @atomicModifyIORef' ref (\x -> (undefined, x))@ +-- +-- and +-- +-- @atomicModifyIORef' ref (\_ -> undefined)@ +-- +-- will each raise an exception in the calling thread, but will /also/ +-- install the bottoming value in the 'IORef', where it may be read by +-- other threads. +-- +-- This function imposes a memory barrier, preventing reordering around +-- the \"atomic block\"; see "Data.IORef#memmodel" for details. -- -- @since 4.6.0.0 atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/31e40fdf2ed3f56f710afe96da7db1ed7b4e21cb...7281d5aa8e7acdae876fab25a27f839efebb80f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/31e40fdf2ed3f56f710afe96da7db1ed7b4e21cb...7281d5aa8e7acdae876fab25a27f839efebb80f2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 19:33:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 26 Mar 2023 15:33:17 -0400 Subject: [Git][ghc/ghc][master] Update and expand atomic modification Haddocks Message-ID: <64209dfda641b_13561a370deef4461029@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - 2 changed files: - libraries/base/Data/IORef.hs - libraries/base/GHC/IORef.hs Changes: ===================================== libraries/base/Data/IORef.hs ===================================== @@ -85,21 +85,45 @@ modifyIORef' ref f = do -- is recommended that if you need to do anything more complicated -- then using 'Control.Concurrent.MVar.MVar' instead is a good idea. -- --- 'atomicModifyIORef' does not apply the function strictly. This is important --- to know even if all you are doing is replacing the value. For example, this --- will leak memory: +-- Conceptually, -- --- >ref <- newIORef '1' --- >forever $ atomicModifyIORef ref (\_ -> ('2', ())) +-- @ +-- atomicModifyIORef ref f = do +-- -- Begin atomic block +-- old <- 'readIORef' ref +-- let r = f old +-- new = fst r +-- 'writeIORef' ref new +-- -- End atomic block +-- case r of +-- (_new, res) -> pure res +-- @ -- --- Use 'atomicModifyIORef'' or 'atomicWriteIORef' to avoid this problem. +-- The actions in the section labeled \"atomic block\" are not subject to +-- interference from other threads. In particular, it is impossible for the +-- value in the 'IORef' to change between the 'readIORef' and 'writeIORef' +-- invocations. -- --- This function imposes a memory barrier, preventing reordering; --- see "Data.IORef#memmodel" for details. +-- The user-supplied function is applied to the value stored in the 'IORef', +-- yielding a new value to store in the 'IORef' and a value to return. After +-- the new value is (lazily) stored in the 'IORef', @atomicModifyIORef@ forces +-- the result pair, but does not force either component of the result. To force +-- /both/ components, use 'atomicModifyIORef''. +-- +-- Note that +-- +-- @atomicModifyIORef ref (\_ -> undefined)@ +-- +-- will raise an exception in the calling thread, but will /also/ +-- install the bottoming value in the 'IORef', where it may be read by +-- other threads. +-- +-- This function imposes a memory barrier, preventing reordering around the +-- \"atomic block\"; see "Data.IORef#memmodel" for details. -- atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b atomicModifyIORef ref f = do - (_old, ~(_new, res)) <- atomicModifyIORef2 ref f + (_old, (_new, res)) <- atomicModifyIORef2 ref f pure res -- | Variant of 'writeIORef'. The prefix "atomic" relates to a fact that ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -134,9 +134,28 @@ atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> data Box a = Box a --- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both --- the value stored in the 'IORef' and the value returned. The new value --- is installed in the 'IORef' before the returned value is forced. +-- | A strict version of 'Data.IORef.atomicModifyIORef'. This forces both the +-- value stored in the 'IORef' and the value returned. +-- +-- Conceptually, +-- +-- @ +-- atomicModifyIORef' ref f = do +-- -- Begin atomic block +-- old <- 'readIORef' ref +-- let r = f old +-- new = fst r +-- 'writeIORef' ref new +-- -- End atomic block +-- case r of +-- (!_new, !res) -> pure res +-- @ +-- +-- The actions in the \"atomic block\" are not subject to interference +-- by other threads. In particular, the value in the 'IORef' cannot +-- change between the 'readIORef' and 'writeIORef' invocations. +-- +-- The new value is installed in the 'IORef' before either value is forced. -- So -- -- @atomicModifyIORef' ref (\x -> (x+1, undefined))@ @@ -144,8 +163,18 @@ data Box a = Box a -- will increment the 'IORef' and then throw an exception in the calling -- thread. -- --- This function imposes a memory barrier, preventing reordering; --- see "Data.IORef#memmodel" for details. +-- @atomicModifyIORef' ref (\x -> (undefined, x))@ +-- +-- and +-- +-- @atomicModifyIORef' ref (\_ -> undefined)@ +-- +-- will each raise an exception in the calling thread, but will /also/ +-- install the bottoming value in the 'IORef', where it may be read by +-- other threads. +-- +-- This function imposes a memory barrier, preventing reordering around +-- the \"atomic block\"; see "Data.IORef#memmodel" for details. -- -- @since 4.6.0.0 atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f93de888fb8be5241b476442045eb40b2a5abbd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f93de888fb8be5241b476442045eb40b2a5abbd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Mar 26 19:33:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 26 Mar 2023 15:33:56 -0400 Subject: [Git][ghc/ghc][master] Document the constructor name for lists Message-ID: <64209e246b39b_13561a36dcfb1446454a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - 1 changed file: - libraries/base/Data/Data.hs Changes: ===================================== libraries/base/Data/Data.hs ===================================== @@ -1136,7 +1136,10 @@ consConstr = mkConstr listDataType "(:)" [] Infix listDataType :: DataType listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr] --- | @since 4.0.0.0 +-- | For historical reasons, the constructor name used for @(:)@ is +-- @"(:)"@. In a derived instance, it would be @":"@. +-- +-- @since 4.0.0.0 instance Data a => Data [a] where gfoldl _ z [] = z [] gfoldl f z (x:xs) = z (:) `f` x `f` xs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1fb56b24e2fe45a6f628f651bfc12b2b9743378 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1fb56b24e2fe45a6f628f651bfc12b2b9743378 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 09:30:50 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 27 Mar 2023 05:30:50 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] wip finalize Message-ID: <6421624ae571c_13561a4468ac10498685@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: b68118ae by romes at 2023-03-27T10:30:42+01:00 wip finalize - - - - - 3 changed files: - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Haskell/Hash.hs Changes: ===================================== hadrian/src/Context.hs ===================================== @@ -97,7 +97,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") pkgHaddockFile :: Context -> Action FilePath pkgHaddockFile context at Context {..} = do root <- buildRoot - version <- pkgUnitId context package + version <- pkgSimpleIdentifier package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -10,7 +10,7 @@ -- Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( - pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, + pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, pkgSimpleIdentifier, pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString ) where @@ -27,6 +27,17 @@ import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId) pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData +-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . +-- The Cabal file is tracked. +-- +-- For an identifier complete with the hash use 'pkgUnitId' +pkgSimpleIdentifier :: Package -> Action String +pkgSimpleIdentifier package = do + cabal <- readPackageData package + return $ if null (version cabal) + then name cabal + else name cabal ++ "-" ++ version cabal + -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. pkgSynopsis :: Package -> Action String pkgSynopsis = fmap synopsis . readPackageData ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -6,7 +6,7 @@ module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where import Development.Shake -import Hadrian.Haskell.Cabal.Type as C +import Hadrian.Haskell.Cabal.Type import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal import Hadrian.Package @@ -41,32 +41,19 @@ pkgUnitId ctx' pkg = do pid <- pkgSimpleIdentifier (package ctx) phash <- pkgHash ctx if pkgName pkg == "rts" - -- The Unit-id will change depending on the way... rTS BReaks. At some - -- point it's not even clear which way we're building + -- The unit-id will change depending on the way, we need to treat the rts separately then pure pid else do -- Other boot packages still hardcode their unit-id to just , but we -- can have hadrian generate a different unit-id for them just as cabal does -- because the boot packages unit-ids are overriden by setting -this-unit-id -- in the cabal file - -- liftIO $ print $ pid <> "-" <> truncateHash 4 phash pure $ pid <> "-" <> truncateHash 4 phash where truncateHash :: Int -> String -> String truncateHash = take --- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . --- The Cabal file is tracked. --- --- For an identifier complete with the hash use 'pkgUnitId' -pkgSimpleIdentifier :: Package -> Action String -pkgSimpleIdentifier package = do - cabal <- readPackageData package - return $ if null (version cabal) - then C.name cabal - else C.name cabal ++ "-" ++ version cabal - data PackageHashInputs = PackageHashInputs { pkgHashPkgId :: String, -- ^ name-version pkgHashComponent :: PackageType, @@ -119,17 +106,14 @@ type instance RuleResult PkgHashKey = String pkgHash :: Context -> Action String pkgHash = askOracle . PkgHashKey --- TODO: Needs to be oracle to be cached? Called lots of times +-- Needs to be an oracle to be cached. Called lots of times. pkgHashOracle :: Rules () pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do - -- RECURSIVE ORACLE: ctx_data <- readContextData ctx pkg_data <- readPackageData (package ctx) name <- pkgSimpleIdentifier (package ctx) let stag = stage ctx - liftIO $ print ("Package and Package Dependencies", package ctx, packageDependencies pkg_data) stagePkgs <- stagePackages stag depsHashes <- mapM (\pkg -> pkgHash (ctx { package = pkg })) [pkg | pkg <- packageDependencies pkg_data, pkg `elem` stagePkgs] - liftIO $ print ("Pkg Deps Hashes", depsHashes) flav <- flavour let flavourArgs = args flav @@ -139,13 +123,13 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do libWays <- interpretInContext ctx (libraryWays flav) dyn_ghc <- dynamicGhcPrograms flav flags <- interpret (target ctx (Cabal Flags stag) [] []) flavourArgs + liftIO$ print ("flav", flav) let pkgHashFlagAssignment = flags pkgHashConfigureScriptArgs = "" pkgHashVanillaLib = vanilla `Set.member` libWays pkgHashSharedLib = dynamic `Set.member` libWays pkgHashDynExe = dyn_ghc - -- TODO: fullyStatic flavour transformer - pkgHashFullyStaticExe = False + pkgHashFullyStaticExe = False -- TODO: fullyStatic flavour transformer pkgHashGHCiLib = False pkgHashProfLib = profiling `Set.member` libWays pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag @@ -158,7 +142,9 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do pkgHashDebugInfo = undefined -- ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs - let pkgHashProgramArgs = mempty -- Map.singleton "ghc" ghcArgs + let pkgHashProgramArgs = mempty -- TODO: Map.singleton "ghc" ghcArgs, + -- but the above call to 'interpret' causes a + -- build-time loop pkgHashExtraLibDirs = [] pkgHashExtraLibDirsStatic = [] pkgHashExtraFrameworkDirs = [] @@ -172,7 +158,7 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do pkgHashPkgId = name , pkgHashComponent = pkgType (package ctx) , pkgHashSourceHash = "" - , pkgHashDirectDeps = Set.empty + , pkgHashDirectDeps = Set.fromList depsHashes , pkgHashOtherConfig = other_config } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b68118ae8d861e4d98e637dc251636efcb3751f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b68118ae8d861e4d98e637dc251636efcb3751f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 09:54:49 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 27 Mar 2023 05:54:49 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] wip finalize Message-ID: <642167e9aae9d_13561a44dd17d05042e8@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: b62fbecf by romes at 2023-03-27T10:54:40+01:00 wip finalize - - - - - 5 changed files: - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Rules/Register.hs Changes: ===================================== hadrian/src/Context.hs ===================================== @@ -97,7 +97,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") pkgHaddockFile :: Context -> Action FilePath pkgHaddockFile context at Context {..} = do root <- buildRoot - version <- pkgUnitId context package + version <- pkgSimpleIdentifier package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -110,22 +110,25 @@ parseWayUnit = Parsec.choice , Parsec.char 'l' *> pure Logging ] Parsec. "way unit (thr, debug, dyn, p, l)" --- | Parse a @"pkgname-pkgversion"@ string into the package name and the +-- | Parse a @"pkgname-pkgversion-pkghash"@ string into the package name and the -- integers that make up the package version. +-- +-- If no hash was assigned, an empty string is returned in its place. parsePkgId :: Parsec.Parsec String () (String, [Integer], String) -parsePkgId = parseRTS <|> (parsePkgId' "" Parsec. "package identifier (--)") +parsePkgId = parsePkgId' "" Parsec. "package identifier (-(-?))" where parsePkgId' currName = do s <- Parsec.many1 Parsec.alphaNum _ <- Parsec.char '-' let newName = if null currName then s else currName ++ "-" ++ s - Parsec.choice [ (,,) newName <$> parsePkgVersion <*> (Parsec.char '-' *> parsePkgHash) - , parsePkgId' newName ] - - parseRTS = do - _ <- Parsec.string "rts" <* Parsec.char '-' - v <- parsePkgVersion - pure ("rts", v, "") + Parsec.choice + [ (,,) newName <$> parsePkgVersion + <*> Parsec.option "" (Parsec.try $ do + _ <- Parsec.char '-' + -- Ensure we're not parsing a libDynName as a hash + _ <- Parsec.notFollowedBy (Parsec.string "ghc" *> parsePkgVersion) + parsePkgHash) + , parsePkgId' newName ] parsePkgHash :: Parsec.Parsec String () String parsePkgHash = Parsec.many1 Parsec.alphaNum ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -10,7 +10,7 @@ -- Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( - pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, + pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, pkgSimpleIdentifier, pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString ) where @@ -27,6 +27,17 @@ import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId) pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData +-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . +-- The Cabal file is tracked. +-- +-- For an identifier complete with the hash use 'pkgUnitId' +pkgSimpleIdentifier :: Package -> Action String +pkgSimpleIdentifier package = do + cabal <- readPackageData package + return $ if null (version cabal) + then name cabal + else name cabal ++ "-" ++ version cabal + -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. pkgSynopsis :: Package -> Action String pkgSynopsis = fmap synopsis . readPackageData ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -6,7 +6,7 @@ module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where import Development.Shake -import Hadrian.Haskell.Cabal.Type as C +import Hadrian.Haskell.Cabal.Type import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal import Hadrian.Package @@ -41,32 +41,19 @@ pkgUnitId ctx' pkg = do pid <- pkgSimpleIdentifier (package ctx) phash <- pkgHash ctx if pkgName pkg == "rts" - -- The Unit-id will change depending on the way... rTS BReaks. At some - -- point it's not even clear which way we're building + -- The unit-id will change depending on the way, we need to treat the rts separately then pure pid else do -- Other boot packages still hardcode their unit-id to just , but we -- can have hadrian generate a different unit-id for them just as cabal does -- because the boot packages unit-ids are overriden by setting -this-unit-id -- in the cabal file - -- liftIO $ print $ pid <> "-" <> truncateHash 4 phash pure $ pid <> "-" <> truncateHash 4 phash where truncateHash :: Int -> String -> String truncateHash = take --- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . --- The Cabal file is tracked. --- --- For an identifier complete with the hash use 'pkgUnitId' -pkgSimpleIdentifier :: Package -> Action String -pkgSimpleIdentifier package = do - cabal <- readPackageData package - return $ if null (version cabal) - then C.name cabal - else C.name cabal ++ "-" ++ version cabal - data PackageHashInputs = PackageHashInputs { pkgHashPkgId :: String, -- ^ name-version pkgHashComponent :: PackageType, @@ -119,17 +106,14 @@ type instance RuleResult PkgHashKey = String pkgHash :: Context -> Action String pkgHash = askOracle . PkgHashKey --- TODO: Needs to be oracle to be cached? Called lots of times +-- Needs to be an oracle to be cached. Called lots of times. pkgHashOracle :: Rules () pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do - -- RECURSIVE ORACLE: ctx_data <- readContextData ctx pkg_data <- readPackageData (package ctx) name <- pkgSimpleIdentifier (package ctx) let stag = stage ctx - liftIO $ print ("Package and Package Dependencies", package ctx, packageDependencies pkg_data) stagePkgs <- stagePackages stag depsHashes <- mapM (\pkg -> pkgHash (ctx { package = pkg })) [pkg | pkg <- packageDependencies pkg_data, pkg `elem` stagePkgs] - liftIO $ print ("Pkg Deps Hashes", depsHashes) flav <- flavour let flavourArgs = args flav @@ -144,8 +128,7 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do pkgHashVanillaLib = vanilla `Set.member` libWays pkgHashSharedLib = dynamic `Set.member` libWays pkgHashDynExe = dyn_ghc - -- TODO: fullyStatic flavour transformer - pkgHashFullyStaticExe = False + pkgHashFullyStaticExe = False -- TODO: fullyStatic flavour transformer pkgHashGHCiLib = False pkgHashProfLib = profiling `Set.member` libWays pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag @@ -158,7 +141,9 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do pkgHashDebugInfo = undefined -- ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs - let pkgHashProgramArgs = mempty -- Map.singleton "ghc" ghcArgs + let pkgHashProgramArgs = mempty -- TODO: Map.singleton "ghc" ghcArgs, + -- but the above call to 'interpret' causes a + -- build-time loop pkgHashExtraLibDirs = [] pkgHashExtraLibDirsStatic = [] pkgHashExtraFrameworkDirs = [] @@ -172,7 +157,7 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do pkgHashPkgId = name , pkgHashComponent = pkgType (package ctx) , pkgHashSourceHash = "" - , pkgHashDirectDeps = Set.empty + , pkgHashDirectDeps = Set.fromList depsHashes , pkgHashOtherConfig = other_config } ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -270,7 +270,7 @@ parseCabalName s = bimap show id (Cabal.runParsecParser nameWithHashParser " do xs' <- Parsec.sepBy component (Parsec.char '-') case reverse xs' of - hash:version_str:xs -> + _hash:version_str:xs -> case Cabal.simpleParsec @Version version_str of Nothing -> fail ("failed to parse a version from " <> version_str) Just v -> View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b62fbecf19f036796a23d83b8f4372307feea729 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b62fbecf19f036796a23d83b8f4372307feea729 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 11:03:40 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 27 Mar 2023 07:03:40 -0400 Subject: [Git][ghc/ghc][wip/interface-loading-errs] 50 commits: Bump Win32 to 2.13.4.0 Message-ID: <6421780ca171c_13561a460f45c45120a5@gitlab.mail> Matthew Pickering pushed to branch wip/interface-loading-errs at Glasgow Haskell Compiler / GHC Commits: 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c03c0c79 by Matthew Pickering at 2023-03-27T12:00:00+01:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Tidy.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Iface/Errors.hs - + compiler/GHC/Iface/Errors/Ppr.hs - + compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d789fd0d265513ec930c72645d1e26e99206b867...c03c0c79607d26e7ecabeff05592a78c8b3ac9e8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d789fd0d265513ec930c72645d1e26e99206b867...c03c0c79607d26e7ecabeff05592a78c8b3ac9e8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 11:47:41 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 27 Mar 2023 07:47:41 -0400 Subject: [Git][ghc/ghc][wip/interface-loading-errs] Convert interface file loading errors into proper diagnostics Message-ID: <6421825d66981_13561a46b86f14525267@gitlab.mail> Matthew Pickering pushed to branch wip/interface-loading-errs at Glasgow Haskell Compiler / GHC Commits: a62f7ac3 by Matthew Pickering at 2023-03-27T12:47:25+01:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - 30 changed files: - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Config/Tidy.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/MakeFile.hs - compiler/GHC/Iface/Errors.hs - + compiler/GHC/Iface/Errors/Ppr.hs - + compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/Error.hs - compiler/ghc.cabal.in - ghc/Main.hs - testsuite/tests/cabal/cabal05/cabal05.stderr - testsuite/tests/cabal/ghcpkg04.stderr - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a62f7ac33d7bbe965b13bb23e29324a164151b2b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a62f7ac33d7bbe965b13bb23e29324a164151b2b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 12:26:54 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 27 Mar 2023 08:26:54 -0400 Subject: [Git][ghc/ghc][wip/plugin-init] 303 commits: ghc-the-library: Retain cafs in both static in dynamic builds. Message-ID: <64218b8e60b46_13561a4785d1fc53272a@gitlab.mail> Matthew Pickering pushed to branch wip/plugin-init at Glasgow Haskell Compiler / GHC Commits: 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - 3268b291 by Matthew Pickering at 2023-03-27T12:56:02+01:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - e73a82f5 by Aaron Allen at 2023-03-27T12:56:02+01:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - c42f3a00 by Matthew Pickering at 2023-03-27T13:20:26+01:00 docs: Add Note [Timing of plugin initialization] - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - cabal.project-reinstall - compile_flags.txt - compiler/CodeGen.Platform.h - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c31e87bbb13c0139b75acd234fd48eeb40cf50af...c42f3a0016dfceb66cd4fc35023734e6edfbf97e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c31e87bbb13c0139b75acd234fd48eeb40cf50af...c42f3a0016dfceb66cd4fc35023734e6edfbf97e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 15:00:43 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 27 Mar 2023 11:00:43 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] Add hashes to unit-ids created by hadrian Message-ID: <6421af9bb5250_13561a4a39de2057733f@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 6cdf5a0e by romes at 2023-03-27T16:00:19+01:00 Add hashes to unit-ids created by hadrian Co-author: @mpickering - - - - - 26 changed files: - hadrian/hadrian.cabal - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - + hadrian/src/Hadrian/Haskell/Hash.hs - + hadrian/src/Hadrian/Haskell/Hash.hs-boot - hadrian/src/Hadrian/Package.hs - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Haddock.hs - testsuite/driver/testlib.py - testsuite/tests/backpack/cabal/bkpcabal02/all.T - testsuite/tests/cabal/t18567/all.T - testsuite/tests/driver/T16318/Makefile - testsuite/tests/driver/T18125/Makefile - testsuite/tests/ghci/scripts/Makefile - testsuite/tests/package/T4806a.stderr - utils/ghc-pkg/Main.hs Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -55,6 +55,7 @@ executable hadrian , Hadrian.BuildPath , Hadrian.Expression , Hadrian.Haskell.Cabal + , Hadrian.Haskell.Hash , Hadrian.Haskell.Cabal.Type , Hadrian.Haskell.Cabal.Parse , Hadrian.Oracles.ArgsHash @@ -163,6 +164,8 @@ executable hadrian , transformers >= 0.4 && < 0.7 , unordered-containers >= 0.2.1 && < 0.3 , text >= 1.2 && < 3 + , cryptohash-sha256 >= 0.11 && < 0.12 + , base16-bytestring >= 0.1.1 && < 1.1.0.0 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Context.hs ===================================== @@ -70,15 +70,15 @@ distDir st = do hostArch <- cabalArchString <$> setting arch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version -pkgFileName :: Package -> String -> String -> Action FilePath -pkgFileName package prefix suffix = do - pid <- pkgIdentifier package +pkgFileName :: Context -> Package -> String -> String -> Action FilePath +pkgFileName context package prefix suffix = do + pid <- pkgUnitId context package return $ prefix ++ pid ++ suffix pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - fileName <- pkgFileName package prefix suffix + fileName <- pkgFileName context package prefix suffix return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. @@ -95,9 +95,9 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile Context {..} = do +pkgHaddockFile context at Context {..} = do root <- buildRoot - version <- pkgIdentifier package + version <- pkgUnitId context package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: @@ -106,7 +106,7 @@ pkgHaddockFile Context {..} = do pkgRegisteredLibraryFile :: Context -> Action FilePath pkgRegisteredLibraryFile context at Context {..} = do libDir <- libPath context - pkgId <- pkgIdentifier package + pkgId <- pkgUnitId context package fileName <- pkgRegisteredLibraryFileName context distDir <- distDir stage return $ if Dynamic `wayUnit` way @@ -115,9 +115,9 @@ pkgRegisteredLibraryFile context at Context {..} = do -- | Just the final filename portion of pkgRegisteredLibraryFile pkgRegisteredLibraryFileName :: Context -> Action FilePath -pkgRegisteredLibraryFileName Context{..} = do +pkgRegisteredLibraryFileName context at Context{..} = do extension <- libsuf stage way - pkgFileName package "libHS" extension + pkgFileName context package "libHS" extension -- | Path to the library file of a given 'Context', e.g.: @@ -136,8 +136,8 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile Context {..} = do - pid <- pkgIdentifier package +pkgConfFile context at Context {..} = do + pid <- pkgUnitId context package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -110,17 +110,28 @@ parseWayUnit = Parsec.choice , Parsec.char 'l' *> pure Logging ] Parsec. "way unit (thr, debug, dyn, p, l)" --- | Parse a @"pkgname-pkgversion"@ string into the package name and the +-- | Parse a @"pkgname-pkgversion-pkghash"@ string into the package name and the -- integers that make up the package version. -parsePkgId :: Parsec.Parsec String () (String, [Integer]) -parsePkgId = parsePkgId' "" Parsec. "package identifier (-)" +-- +-- If no hash was assigned, an empty string is returned in its place. +parsePkgId :: Parsec.Parsec String () (String, [Integer], String) +parsePkgId = parsePkgId' "" Parsec. "package identifier (-(-?))" where parsePkgId' currName = do s <- Parsec.many1 Parsec.alphaNum _ <- Parsec.char '-' let newName = if null currName then s else currName ++ "-" ++ s - Parsec.choice [ (newName,) <$> parsePkgVersion - , parsePkgId' newName ] + Parsec.choice + [ (,,) newName <$> parsePkgVersion + <*> Parsec.option "" (Parsec.try $ do + _ <- Parsec.char '-' + -- Ensure we're not parsing a libDynName as a hash + _ <- Parsec.notFollowedBy (Parsec.string "ghc" *> parsePkgVersion) + parsePkgHash) + , parsePkgId' newName ] + +parsePkgHash :: Parsec.Parsec String () String +parsePkgHash = Parsec.many1 Parsec.alphaNum -- | Parse "."-separated integers that describe a package's version. parsePkgVersion :: Parsec.Parsec String () [Integer] ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -10,8 +10,8 @@ -- Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( - pkgVersion, pkgIdentifier, pkgSynopsis, pkgDescription, pkgDependencies, - pkgGenericDescription, cabalArchString, cabalOsString, + pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, pkgSimpleIdentifier, + pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString ) where import Development.Shake @@ -20,15 +20,19 @@ import Distribution.PackageDescription (GenericPackageDescription) import Hadrian.Haskell.Cabal.Type import Hadrian.Oracles.Cabal import Hadrian.Package +import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId) + -- | Read a Cabal file and return the package version. The Cabal file is tracked. pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData --- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0 at . +-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . -- The Cabal file is tracked. -pkgIdentifier :: Package -> Action String -pkgIdentifier package = do +-- +-- For an identifier complete with the hash use 'pkgUnitId' +pkgSimpleIdentifier :: Package -> Action String +pkgSimpleIdentifier package = do cabal <- readPackageData package return $ if null (version cabal) then name cabal @@ -72,3 +76,4 @@ cabalOsString "mingw32" = "windows" cabalOsString "darwin" = "osx" cabalOsString "solaris2" = "solaris" cabalOsString other = other + ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -345,7 +345,7 @@ registerPackage rs context = do pd <- packageDescription <$> readContextData context db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context)) dist_dir <- Context.buildPath context - pid <- pkgIdentifier (package context) + pid <- pkgUnitId context (package context) -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path -- from the local build info @lbi at . lbi <- liftIO $ C.getPersistBuildConfig cPath @@ -357,12 +357,12 @@ registerPackage rs context = do -- This is copied and simplified from Cabal, because we want to install the package -- into a different package database to the one it was configured against. register :: FilePath - -> FilePath + -> String -- ^ Package Identifier -> FilePath -> C.PackageDescription -> LocalBuildInfo -> IO () -register pkg_db conf_file build_dir pd lbi +register pkg_db pid build_dir pd lbi = withLibLBI pd lbi $ \lib clbi -> do absPackageDBs <- C.absolutePackageDBPaths packageDbs @@ -373,13 +373,13 @@ register pkg_db conf_file build_dir pd lbi writeRegistrationFile installedPkgInfo where - regFile = conf_file + regFile = pkg_db pid <.> "conf" reloc = relocatable lbi -- Using a specific package db here is why we have to copy the function from Cabal. packageDbs = [C.SpecificPackageDB pkg_db] writeRegistrationFile installedPkgInfo = do - writeUTF8File (pkg_db regFile <.> "conf") (CP.showInstalledPackageInfo installedPkgInfo) + writeUTF8File regFile (CP.showInstalledPackageInfo installedPkgInfo) -- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs at . ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -0,0 +1,230 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where + +import Development.Shake + +import Hadrian.Haskell.Cabal.Type +import Hadrian.Haskell.Cabal +import Hadrian.Oracles.Cabal +import Hadrian.Package + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as BS +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import Data.List +import Context.Type +import Oracles.Setting +import Hadrian.Target +import Hadrian.Expression +import Builder +import Flavour.Type +import Settings +import Way.Type +import Way +import Packages +import Development.Shake.Classes +import Control.Monad + + +-- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd at . +-- This needs to be an oracle so it's cached +pkgUnitId :: Context -> Package -> Action String +pkgUnitId ctx' pkg = do + let ctx = ctx'{package = pkg} + pid <- pkgSimpleIdentifier (package ctx) + phash <- pkgHash ctx + if pkgName pkg == "rts" + -- The unit-id will change depending on the way, we need to treat the rts separately + then pure pid + else do + -- Other boot packages still hardcode their unit-id to just , but we + -- can have hadrian generate a different unit-id for them just as cabal does + -- because the boot packages unit-ids are overriden by setting -this-unit-id + -- in the cabal file + pure $ pid <> "-" <> truncateHash 4 phash + + where + truncateHash :: Int -> String -> String + truncateHash = take + +data PackageHashInputs = PackageHashInputs { + pkgHashPkgId :: String, -- ^ name-version + pkgHashComponent :: PackageType, + pkgHashSourceHash :: BS.ByteString, + -- pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion), + pkgHashDirectDeps :: Set.Set String, + pkgHashOtherConfig :: PackageHashConfigInputs + } + +-- | Those parts of the package configuration that contribute to the +-- package hash computed by hadrian (which is simpler than cabal's). +-- +-- setting in Oracle.setting, which come from system.config +data PackageHashConfigInputs = PackageHashConfigInputs { + pkgHashCompilerId :: String, + pkgHashPlatform :: String, + pkgHashFlagAssignment :: [String], -- complete not partial + -- pkgHashConfigureScriptArgs :: [String], -- just ./configure for build-type Configure + pkgHashVanillaLib :: Bool, + pkgHashSharedLib :: Bool, + pkgHashDynExe :: Bool, + pkgHashFullyStaticExe :: Bool, + pkgHashGHCiLib :: Bool, + pkgHashProfLib :: Bool, + pkgHashProfExe :: Bool, +-- pkgHashProfLibDetail :: ProfDetailLevel, +-- pkgHashProfExeDetail :: ProfDetailLevel, + pkgHashCoverage :: Bool, + pkgHashOptimization :: Int, + pkgHashSplitObjs :: Bool, + pkgHashSplitSections :: Bool, + pkgHashStripLibs :: Bool, + pkgHashStripExes :: Bool, +-- pkgHashDebugInfo :: DebugInfoLevel, + pkgHashProgramArgs :: Map String [String], + pkgHashExtraLibDirs :: [FilePath], + pkgHashExtraLibDirsStatic :: [FilePath], + pkgHashExtraFrameworkDirs :: [FilePath], + pkgHashExtraIncludeDirs :: [FilePath] + -- pkgHashProgPrefix :: Maybe PathTemplate, + -- pkgHashProgSuffix :: Maybe PathTemplate, + -- pkgHashPackageDbs :: [Maybe PackageDB] + } + deriving Show + +newtype PkgHashKey = PkgHashKey Context + deriving (Binary, Eq, Hashable, NFData, Show, Typeable) +type instance RuleResult PkgHashKey = String + +pkgHash :: Context -> Action String +pkgHash = askOracle . PkgHashKey + +-- Needs to be an oracle to be cached. Called lots of times. +pkgHashOracle :: Rules () +pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do + pkg_data <- readPackageData (package ctx) + name <- pkgSimpleIdentifier (package ctx) + let stag = stage ctx + stagePkgs <- stagePackages stag + depsHashes <- mapM (\pkg -> pkgHash (ctx { package = pkg })) [pkg | pkg <- packageDependencies pkg_data, pkg `elem` stagePkgs] + flav <- flavour + let flavourArgs = args flav + + targetOs <- setting TargetOs + let pkgHashCompilerId = "" + pkgHashPlatform = targetOs + libWays <- interpretInContext ctx (libraryWays flav) + dyn_ghc <- dynamicGhcPrograms flav + flags <- interpret (target ctx (Cabal Flags stag) [] []) flavourArgs + let pkgHashFlagAssignment = flags + pkgHashConfigureScriptArgs = "" + pkgHashVanillaLib = vanilla `Set.member` libWays + pkgHashSharedLib = dynamic `Set.member` libWays + pkgHashDynExe = dyn_ghc + pkgHashFullyStaticExe = False -- TODO: fullyStatic flavour transformer + pkgHashGHCiLib = False + pkgHashProfLib = profiling `Set.member` libWays + pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag + pkgHashCoverage = False -- Can't configure this + pkgHashOptimization = 0 -- TODO: A bit tricky to configure + pkgHashSplitObjs = False -- Deprecated + pkgHashSplitSections = ghcSplitSections flav + pkgHashStripExes = False + pkgHashStripLibs = False + pkgHashDebugInfo = undefined + + -- ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs + let pkgHashProgramArgs = mempty -- TODO: Map.singleton "ghc" ghcArgs, + -- but the above call to 'interpret' causes a + -- build-time loop + pkgHashExtraLibDirs = [] + pkgHashExtraLibDirsStatic = [] + pkgHashExtraFrameworkDirs = [] + pkgHashExtraIncludeDirs = [] + + let other_config = PackageHashConfigInputs{..} + + return $ BS.unpack $ Base16.encode $ SHA256.hash $ + renderPackageHashInputs $ PackageHashInputs + { + pkgHashPkgId = name + , pkgHashComponent = pkgType (package ctx) + , pkgHashSourceHash = "" + , pkgHashDirectDeps = Set.fromList depsHashes + , pkgHashOtherConfig = other_config + } + +prettyShow, showHashValue :: Show a => a -> String +prettyShow = show +showHashValue = show + +renderPackageHashInputs :: PackageHashInputs -> BS.ByteString +renderPackageHashInputs PackageHashInputs{ + pkgHashPkgId, + pkgHashComponent, + pkgHashSourceHash, + pkgHashDirectDeps, + -- pkgHashPkgConfigDeps, + pkgHashOtherConfig = + PackageHashConfigInputs{..} + } = + -- The purpose of this somewhat laboured rendering (e.g. why not just + -- use show?) is so that existing package hashes do not change + -- unnecessarily when new configuration inputs are added into the hash. + BS.pack $ unlines $ catMaybes $ + [ entry "pkgid" prettyShow pkgHashPkgId +-- , mentry "component" show pkgHashComponent + , entry "src" showHashValue pkgHashSourceHash + {- + , entry "pkg-config-deps" + (intercalate ", " . map (\(pn, mb_v) -> prettyShow pn ++ + case mb_v of + Nothing -> "" + Just v -> " " ++ prettyShow v) + . Set.toList) pkgHashPkgConfigDeps + -} + , entry "deps" (intercalate ", " . map prettyShow + . Set.toList) pkgHashDirectDeps + -- and then all the config + , entry "compilerid" prettyShow pkgHashCompilerId + , entry "platform" prettyShow pkgHashPlatform + , opt "flags" mempty show pkgHashFlagAssignment +-- , opt "configure-script" [] unwords pkgHashConfigureScriptArgs + , opt "vanilla-lib" True prettyShow pkgHashVanillaLib + , opt "shared-lib" False prettyShow pkgHashSharedLib + , opt "dynamic-exe" False prettyShow pkgHashDynExe + , opt "fully-static-exe" False prettyShow pkgHashFullyStaticExe + , opt "ghci-lib" False prettyShow pkgHashGHCiLib + , opt "prof-lib" False prettyShow pkgHashProfLib + , opt "prof-exe" False prettyShow pkgHashProfExe + -- , opt "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail + -- , opt "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail + , opt "hpc" False prettyShow pkgHashCoverage + , opt "optimisation" 0 (show) pkgHashOptimization + , opt "split-objs" False prettyShow pkgHashSplitObjs + , opt "split-sections" False prettyShow pkgHashSplitSections + , opt "stripped-lib" False prettyShow pkgHashStripLibs + , opt "stripped-exe" True prettyShow pkgHashStripExes +-- , opt "debug-info" NormalDebugInfo (show . fromEnum) pkgHashDebugInfo + , opt "extra-lib-dirs" [] unwords pkgHashExtraLibDirs + , opt "extra-lib-dirs-static" [] unwords pkgHashExtraLibDirsStatic + , opt "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs + , opt "extra-include-dirs" [] unwords pkgHashExtraIncludeDirs +-- , opt "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix +-- , opt "prog-suffix" Nothing (maybe "" fromPathTemplate) pkgHashProgSuffix +-- , opt "package-dbs" [] (unwords . map show) pkgHashPackageDbs + + ] ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs + where + entry key format value = Just (key ++ ": " ++ format value) + mentry key format value = fmap (\v -> key ++ ": " ++ format v) value + opt key def format value + | value == def = Nothing + | otherwise = entry key format value ===================================== hadrian/src/Hadrian/Haskell/Hash.hs-boot ===================================== @@ -0,0 +1,8 @@ +module Hadrian.Haskell.Hash where + +import Context.Type +import Hadrian.Package +import Development.Shake + +pkgUnitId :: Context -> Package -> Action String + ===================================== hadrian/src/Hadrian/Package.hs ===================================== @@ -81,4 +81,4 @@ instance NFData PackageType instance Binary Package instance Hashable Package -instance NFData Package \ No newline at end of file +instance NFData Package ===================================== hadrian/src/Rules.hs ===================================== @@ -8,6 +8,7 @@ import qualified Hadrian.Oracles.Cabal.Rules import qualified Hadrian.Oracles.DirectoryContents import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile +import qualified Hadrian.Haskell.Hash import Expression import qualified Oracles.Flavour @@ -142,6 +143,7 @@ oracleRules :: Rules () oracleRules = do Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs Hadrian.Oracles.Cabal.Rules.cabalOracle + Hadrian.Haskell.Hash.pkgHashOracle Hadrian.Oracles.DirectoryContents.directoryContentsOracle Hadrian.Oracles.Path.pathOracle Hadrian.Oracles.TextFile.textFileOracle ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,7 +132,8 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -10,7 +10,7 @@ import Utilities import qualified System.Directory.Extra as IO import Data.Either import Rules.BinaryDist -import Hadrian.Haskell.Cabal (pkgIdentifier) +import Hadrian.Haskell.Cabal (pkgUnitId) import Oracles.Setting {- @@ -54,7 +54,8 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -293,7 +293,7 @@ parsePkgDocTarget root = do _ <- Parsec.string root *> Parsec.optional (Parsec.char '/') _ <- Parsec.string (htmlRoot ++ "/") _ <- Parsec.string "libraries/" - (pkgname, _) <- parsePkgId <* Parsec.char '/' + (pkgname, _, _) <- parsePkgId <* Parsec.char '/' Parsec.choice [ Parsec.try (Parsec.string "haddock-prologue.txt") *> pure (HaddockPrologue pkgname) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -14,6 +14,7 @@ import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting import Hadrian.Haskell.Cabal.Type (PackageData(version)) +import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal (readPackageData) import Packages import Rules.Libffi @@ -487,16 +488,15 @@ generateConfigHs = do trackGenerateHs cProjectName <- getSetting ProjectName cBooterVersion <- getSetting GhcVersion - cProjectVersionMunged <- getSetting ProjectVersionMunged - -- ROMES:TODO:HASH First we attempt a fixed unit-id with version but without hash. - -- - -- We now use a more informative unit-id for ghc. See Note [GHC's Unit Id] - -- in GHC.Unit.Types + -- We now give a unit-id with a version and a hash to ghc. + -- See Note [GHC's Unit Id] in GHC.Unit.Types -- -- It's crucial that the unit-id matches the unit-key -- ghc is no longer -- part of the WiringMap, so we don't to go back and forth between the - -- unit-id and the unit-key -- we take care here that they are the same. - let cProjectUnitId = "ghc-" ++ cProjectVersionMunged -- ROMES:TODO:HASH + -- unit-id and the unit-key -- we take care that they are the same by using + -- 'pkgUnitId' on 'compiler' (the ghc-library package) to create the + -- unit-id in both situations. + cProjectUnitId <- expr . (`pkgUnitId` compiler) =<< getContext return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -593,3 +593,5 @@ generatePlatformHostHs = do , "hostPlatformArchOS :: ArchOS" , "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS" ] + + ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -45,7 +45,7 @@ libraryRules = do registerStaticLib :: FilePath -> FilePath -> Action () registerStaticLib root archivePath = do -- Simply need the ghc-pkg database .conf file. - GhcPkgPath _ stage _ (LibA name _ w) + GhcPkgPath _ stage _ (LibA name _ _ w) <- parsePath (parseGhcPkgLibA root) "<.a library (register) path parser>" archivePath @@ -56,7 +56,7 @@ registerStaticLib root archivePath = do -- the second argument. buildStaticLib :: FilePath -> FilePath -> Action () buildStaticLib root archivePath = do - l@(BuildPath _ stage _ (LibA pkgname _ way)) + l@(BuildPath _ stage _ (LibA pkgname _ _ way)) <- parsePath (parseBuildLibA root) "<.a library (build) path parser>" archivePath @@ -75,7 +75,7 @@ buildStaticLib root archivePath = do registerDynamicLib :: FilePath -> String -> FilePath -> Action () registerDynamicLib root suffix dynlibpath = do -- Simply need the ghc-pkg database .conf file. - (GhcPkgPath _ stage _ (LibDyn name _ w _)) + (GhcPkgPath _ stage _ (LibDyn name _ _ w _)) <- parsePath (parseGhcPkgLibDyn root suffix) "" dynlibpath @@ -99,7 +99,7 @@ buildDynamicLib root suffix dynlibpath = do -- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. buildGhciLibO :: FilePath -> FilePath -> Action () buildGhciLibO root ghcilibPath = do - l@(BuildPath _ stage _ (LibGhci _ _ _)) + l@(BuildPath _ stage _ (LibGhci _ _ _ _)) <- parsePath (parseBuildLibGhci root) "<.o ghci lib (build) path parser>" ghcilibPath @@ -134,7 +134,7 @@ files etc. buildPackage :: FilePath -> FilePath -> Action () buildPackage root fp = do - l@(BuildPath _ _ _ (PkgStamp _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp + l@(BuildPath _ _ _ (PkgStamp _ _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp let ctx = stampContext l srcs <- hsSources ctx gens <- interpretInContext ctx generatedDependencies @@ -226,47 +226,47 @@ needLibrary cs = need =<< concatMapM (libraryTargets True) cs -- * Library paths types and parsers --- | > libHS-[_].a -data LibA = LibA String [Integer] Way deriving (Eq, Show) +-- | > libHS--[_].a +data LibA = LibA String [Integer] String Way deriving (Eq, Show) -- | > data DynLibExt = So | Dylib deriving (Eq, Show) --- | > libHS-[_]-ghc. -data LibDyn = LibDyn String [Integer] Way DynLibExt deriving (Eq, Show) +-- | > libHS--[_]-ghc. +data LibDyn = LibDyn String [Integer] String Way DynLibExt deriving (Eq, Show) --- | > HS-[_].o -data LibGhci = LibGhci String [Integer] Way deriving (Eq, Show) +-- | > HS--[_].o +data LibGhci = LibGhci String [Integer] String Way deriving (Eq, Show) -- | Get the 'Context' corresponding to the build path for a given static library. libAContext :: BuildPath LibA -> Context -libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) = +libAContext (BuildPath _ stage pkgpath (LibA pkgname _ _ way)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given GHCi library. libGhciContext :: BuildPath LibGhci -> Context -libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) = +libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ _ way)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given dynamic library. libDynContext :: BuildPath LibDyn -> Context -libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = +libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ _ way _)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given static library. stampContext :: BuildPath PkgStamp -> Context -stampContext (BuildPath _ stage _ (PkgStamp pkgname _ way)) = +stampContext (BuildPath _ stage _ (PkgStamp pkgname _ _ way)) = Context stage pkg way Final where pkg = unsafeFindPackageByName pkgname -data PkgStamp = PkgStamp String [Integer] Way deriving (Eq, Show) +data PkgStamp = PkgStamp String [Integer] String Way deriving (Eq, Show) -- | Parse a path to a ghci library to be built, making sure the path starts @@ -313,34 +313,34 @@ parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext) parseLibAFilename :: Parsec.Parsec String () LibA parseLibAFilename = do _ <- Parsec.string "libHS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- parseWaySuffix vanilla _ <- Parsec.string ".a" - return (LibA pkgname pkgver way) + return (LibA pkgname pkgver pkghash way) -- | Parse the filename of a ghci library to be built into a 'LibGhci' value. parseLibGhciFilename :: Parsec.Parsec String () LibGhci parseLibGhciFilename = do _ <- Parsec.string "HS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId _ <- Parsec.string "." way <- parseWayPrefix vanilla _ <- Parsec.string "o" - return (LibGhci pkgname pkgver way) + return (LibGhci pkgname pkgver pkghash way) -- | Parse the filename of a dynamic library to be built into a 'LibDyn' value. parseLibDynFilename :: String -> Parsec.Parsec String () LibDyn parseLibDynFilename ext = do _ <- Parsec.string "libHS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- addWayUnit Dynamic <$> parseWaySuffix dynamic _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion _ <- Parsec.string ("." ++ ext) - return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) + return (LibDyn pkgname pkgver pkghash way $ if ext == "so" then So else Dylib) parseStamp :: Parsec.Parsec String () PkgStamp parseStamp = do _ <- Parsec.string "stamp-" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- parseWaySuffix vanilla - return (PkgStamp pkgname pkgver way) + return (PkgStamp pkgname pkgver pkghash way) ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeApplications #-} module Rules.Register ( configurePackageRules, registerPackageRules, registerPackages, libraryTargets @@ -20,11 +21,15 @@ import Utilities import Hadrian.Haskell.Cabal.Type import qualified Text.Parsec as Parsec import qualified Data.Set as Set +import qualified Data.Char as Char +import Data.Bifunctor (bimap) import Distribution.Version (Version) -import qualified Distribution.Parsec as Cabal -import qualified Distribution.Types.PackageName as Cabal import qualified Distribution.Types.PackageId as Cabal +import qualified Distribution.Types.PackageName as Cabal +import qualified Distribution.Parsec as Cabal +import qualified Distribution.Parsec.FieldLineStream as Cabal +import qualified Distribution.Compat.CharParsing as CabalCharParsing import qualified Hadrian.Haskell.Cabal.Parse as Cabal import qualified System.Directory as IO @@ -183,7 +188,7 @@ buildConfFinal rs context at Context {..} _conf = do -- so that if any change ends up modifying a library (but not its .conf -- file), we still rebuild things that depend on it. dir <- (-/-) <$> libPath context <*> distDir stage - pkgid <- pkgIdentifier package + pkgid <- pkgUnitId context package files <- liftIO $ (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] @@ -251,11 +256,32 @@ getPackageNameFromConfFile conf takeBaseName conf ++ ": " ++ err Right (name, _) -> return name +-- | Parse a cabal-like name parseCabalName :: String -> Either String (String, Version) -parseCabalName = fmap f . Cabal.eitherParsec +-- Try to parse a name with a hash, but otherwise parse a name without one. +parseCabalName s = bimap show id (Cabal.runParsecParser nameWithHashParser "" $ Cabal.fieldLineStreamFromString s) + <|> fmap f (Cabal.eitherParsec s) where f :: Cabal.PackageId -> (String, Version) f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id) + -- Definition similar to 'Parsec PackageIdentifier' from Cabal but extended + -- with logic for parsing the hash (despite not returning it) + nameWithHashParser :: Cabal.ParsecParser (String, Version) + nameWithHashParser = Cabal.PP $ \_ -> do + xs' <- Parsec.sepBy component (Parsec.char '-') + case reverse xs' of + _hash:version_str:xs -> + case Cabal.simpleParsec @Version version_str of + Nothing -> fail ("failed to parse a version from " <> version_str) + Just v -> + if not (null xs) && all (\c -> all (/= '.') c && not (all Char.isDigit c)) xs + then return $ (intercalate "-" (reverse xs), v) + else fail "all digits or a dot in a portion of package name" + _ -> fail "couldn't parse a hash, a version and a name" + where + component = CabalCharParsing.munch1 (\c -> Char.isAlphaNum c || c == '.') + + -- | Return extra library targets. extraTargets :: Context -> Action [FilePath] ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -84,8 +84,9 @@ cabalSetupArgs = builder (Cabal Setup) ? do commonCabalArgs :: Stage -> Args commonCabalArgs stage = do verbosity <- expr getVerbosity + ctx <- getContext pkg <- getPackage - package_id <- expr $ pkgIdentifier pkg + package_id <- expr $ pkgUnitId ctx pkg let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..") mconcat [ -- Don't strip libraries when cross compiling. -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, @@ -101,7 +102,7 @@ commonCabalArgs stage = do , arg "--cabal-file" , arg $ pkgCabalFile pkg , arg "--ipid" - , arg "$pkg-$version" + , arg package_id , arg "--prefix" , arg prefix ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -243,21 +243,24 @@ wayGhcArgs = do , (way == debug || way == debugDynamic) ? pure ["-ticky", "-DTICKY_TICKY"] ] +-- | Args related to correct handling of packages, such as setting +-- -this-unit-id and passing -package-id for dependencies packageGhcArgs :: Args packageGhcArgs = do package <- getPackage + ctx <- getContext ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) -- ROMES: Until the boot compiler no longer needs ghc's -- unit-id to be "ghc", the stage0 compiler must be built -- with `-this-unit-id ghc`, while the wired-in unit-id of -- ghc is correctly set to the unit-id we'll generate for - -- stage1 (set in generateVersionHs in Rules.Generate). + -- stage1 (set in generateConfigHs in Rules.Generate). -- -- However, we don't need to set the unit-id of "ghc" to "ghc" when -- building stage0 because we have a flag in compiler/ghc.cabal.in that is -- sets `-this-unit-id ghc` when hadrian is building stage0, which will -- overwrite this one. - pkgId <- expr $ pkgIdentifier package + pkgId <- expr $ pkgUnitId ctx package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -42,7 +42,7 @@ haddockBuilderArgs = mconcat version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg haddocks <- expr $ haddockDependencies context - haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks] + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgUnitId context p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) ===================================== testsuite/driver/testlib.py ===================================== @@ -930,8 +930,9 @@ def normalise_win32_io_errors(name, opts): def normalise_version_( *pkgs ): def normalise_version__( str ): - return re.sub('(' + '|'.join(map(re.escape,pkgs)) + ')-[0-9.]+(-[0-9a-f]+)?', - '\\1-', str) + # (name)(-version)(-hash)(-components) + return re.sub('(' + '|'.join(map(re.escape,pkgs)) + ')-[0-9.]+(-[0-9a-zA-Z]+)?(-[0-9a-zA-Z]+)?', + '\\1--', str) return normalise_version__ def normalise_version( *pkgs ): ===================================== testsuite/tests/backpack/cabal/bkpcabal02/all.T ===================================== @@ -5,6 +5,6 @@ else: test('bkpcabal02', [extra_files(['p', 'q', 'bkpcabal02.cabal', 'Setup.hs']), - js_broken(22351)], + js_broken(22351), normalise_version('bkpcabal01')], run_command, ['$MAKE -s --no-print-directory bkpcabal02 ' + cleanup]) ===================================== testsuite/tests/cabal/t18567/all.T ===================================== @@ -6,6 +6,7 @@ else: test('T18567', [ extra_files(['Setup.hs', 'sublib/', 'sublib-unused', 'src/', 'internal-lib.cabal']) , js_broken(22356) + , normalise_version('internal-lib') ], run_command, ['$MAKE -s --no-print-directory T18567 ' + cleanup]) ===================================== testsuite/tests/driver/T16318/Makefile ===================================== @@ -5,7 +5,7 @@ include $(TOP)/mk/test.mk test_pe = test-package-environment T16318: - "$(GHC_PKG)" latest base > $(test_pe) + "$(GHC_PKG)" field base id --simple-output > $(test_pe) "$(TEST_HC)" $(TEST_HC_OPTS) -v1 -ignore-dot-ghci -package-env $(test_pe) -e "putStrLn \"Hello\"" > out 2>&1 C=`cat out | grep "Loaded package environment" -c` ; \ if [ $$C != "1" ]; then false; fi ===================================== testsuite/tests/driver/T18125/Makefile ===================================== @@ -6,8 +6,8 @@ test_pe = test-package-environment test_lib = containers T18125: - "$(GHC_PKG)" latest base > $(test_pe) - "$(GHC_PKG)" latest $(test_lib) >> $(test_pe) + "$(GHC_PKG)" field base id --simple-output > $(test_pe) + "$(GHC_PKG)" field $(test_lib) id --simple-outpu >> $(test_pe) "$(TEST_HC)" $(TEST_HC_OPTS) -Wunused-packages -package-env $(test_pe) T18125.hs > out 2>&1 C=`cat out | grep "$(test_lib)" -c` ; \ if [ $$C != "1" ]; then false; fi ===================================== testsuite/tests/ghci/scripts/Makefile ===================================== @@ -69,4 +69,4 @@ T12023: .PHONY: T19650_setup T19650_setup: - '$(GHC_PKG)' latest base > my_package_env + '$(GHC_PKG)' field base id --simple-output > my_package_env ===================================== testsuite/tests/package/T4806a.stderr ===================================== @@ -1,7 +1,7 @@ T4806a.hs:1:1: error: Could not load module ‘Data.Map’ - It is a member of the package ‘containers-0.6.6’ + It is a member of the package ‘containers-0.6.7-4362’ which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies: - deepseq-1.4.8.0 template-haskell-2.20.0.0 + deepseq-1.4.8.1-c027 template-haskell-2.20.0.0-4d68 Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -23,6 +23,7 @@ module Main (main) where +import Debug.Trace import qualified GHC.Unit.Database as GhcPkg import GHC.Unit.Database hiding (mkMungePathUrl) import GHC.HandleEncoding @@ -1600,7 +1601,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do simplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO () simplePackageList my_flags pkgs = do let showPkg :: InstalledPackageInfo -> String - showPkg | FlagShowUnitIds `elem` my_flags = display . installedUnitId + showPkg | FlagShowUnitIds `elem` my_flags = traceId . display . installedUnitId | FlagNamesOnly `elem` my_flags = display . mungedName . mungedId | otherwise = display . mungedId strs = map showPkg pkgs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6cdf5a0eefbe40a9b9c88cb7a8fac85a4508eb1c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6cdf5a0eefbe40a9b9c88cb7a8fac85a4508eb1c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 16:01:17 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 27 Mar 2023 12:01:17 -0400 Subject: [Git][ghc/ghc][wip/expand-do] wrap the mfix function arg tuple in a lazy pattern so that we do not go in a recursive loop Message-ID: <6421bdcde7d88_13561a4b423c54582451@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 7bbd88de by Apoorv Ingle at 2023-03-27T11:01:05-05:00 wrap the mfix function arg tuple in a lazy pattern so that we do not go in a recursive loop - - - - - 5 changed files: - compiler/GHC/Tc/Gen/Match.hs - testsuite/tests/rebindable/T18324.hs - testsuite/tests/rebindable/T18324b.hs - testsuite/tests/rebindable/all.T - + testsuite/tests/rebindable/simple-rec.hs Changes: ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1296,17 +1296,17 @@ expand_do_stmts do_or_lc return_stmt :: ExprLStmt GhcRn return_stmt = noLocA $ LastStmt noExtField - (-- mkHsApp (noLocA return_fun) - -- $ - mkBigLHsTup (map nlHsVar all_ids) noExtField) + (mkBigLHsTup (map nlHsVar all_ids) noExtField) Nothing (SyntaxExprRn return_fun) do_stmts :: XRec GhcRn [ExprLStmt GhcRn] do_stmts = noLocA $ (unLoc rec_stmts) ++ [return_stmt] do_block :: LHsExpr GhcRn - do_block = noLocA $ HsDo noExtField (MDoExpr Nothing) $ do_stmts + do_block = noLocA $ HsDo noExtField (DoExpr Nothing) $ do_stmts mfix_expr :: LHsExpr GhcRn - mfix_expr = mkHsLam [ mkBigLHsVarPatTup all_ids ] $ do_block + mfix_expr = mkHsLam [ noLocA (LazyPat noExtField $ mkBigLHsVarPatTup all_ids) ] $ do_block + -- LazyPat becuase we do not want to eagerly evaluate the pattern + -- and potentially loop forever expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = -- See Note [Applicative BodyStmt] ===================================== testsuite/tests/rebindable/T18324.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE ImpredicativeTypes, DeriveAnyClass #-} --- {-# LANGUAGE MonadComprehensions, RecursiveDo #-} + module Main where type Id = forall a. a -> a @@ -14,6 +14,10 @@ foo1 = t >>= \x -> return (p x) foo2 = do { x <- t ; return (p x) } +blah x y = return (3::Int) + main = do x <- foo1 putStrLn $ show x + + ===================================== testsuite/tests/rebindable/T18324b.hs ===================================== @@ -62,17 +62,8 @@ data HsDataDefn pass data FamEqn pass rhs = FamEqn { feqn_tycon :: LIdP pass - --- LIdP (GhcRn) ~~> - , feqn_rhs :: rhs } --- type TyFamInstEqn pass = FamEqn pass (LHsType pass) - --- data TyFamInstDecl pass --- = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass } - - fffggg :: ClsInstDecl GhcRn -> [Int] fffggg ddd = -- let -- data_fams = @@ -86,3 +77,5 @@ fffggg ddd = -- let -- TyFamInstDecl { tfid_eqn = FamEqn { feqn_tycon = L l _ } } <- unLoc <$> cid_tyfam_insts ddd -- [ 0 ] -- in data_fams ++ ty_fams + + ===================================== testsuite/tests/rebindable/all.T ===================================== @@ -46,3 +46,4 @@ test('T20126', normal, compile_fail, ['']) test('T18324', normal, compile, ['']) test('T23147', normal, compile, ['']) test('pattern-fails', normal, compile_and_run, ['']) +test('simple-rec', normal, compile_and_run, ['']) ===================================== testsuite/tests/rebindable/simple-rec.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE RecursiveDo #-} +module Main where + + +blah x y = return (3::Int) + +main = do -- x <- foo1 + rec { y <- blah x y + ; x <- blah x y + } + putStrLn $ show x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bbd88de8535ade0bb26864e2d0021550a83ddcb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bbd88de8535ade0bb26864e2d0021550a83ddcb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 16:41:14 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 27 Mar 2023 12:41:14 -0400 Subject: [Git][ghc/ghc][wip/romes/rep-arity] Account for all VoidRep types on precomputedStaticConInfo Message-ID: <6421c72aec0a2_13561a4bef74785952b5@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rep-arity at Glasgow Haskell Compiler / GHC Commits: 59234911 by romes at 2023-03-27T17:41:04+01:00 Account for all VoidRep types on precomputedStaticConInfo Previously, we were considering coercion values whose unlifted type equality had a zerobit runtime representation (VoidRep) to be constructor arguments when determining whether we should pre-compute a staticConInfo for a data constructor. This made it so that GADT constructors with type-equality constraints that should have no runtime representation actually ended up impacting the code generation. Fixes #23158 - - - - - 2 changed files: - compiler/GHC/Core/DataCon.hs - + compiler/GHC/Types/RepType.hs-boot Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -79,6 +79,7 @@ import GHC.Core.TyCo.Subst import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.Multiplicity import {-# SOURCE #-} GHC.Types.TyThing +import {-# SOURCE #-} GHC.Types.RepType (isZeroBitTy) import GHC.Types.FieldLabel import GHC.Types.SourceText import GHC.Core.Class @@ -111,8 +112,8 @@ import Data.List( find ) import Language.Haskell.Syntax.Module.Name {- -Data constructor representation -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Data constructor representation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the following Haskell data type declaration data T = T !Int ![Int] @@ -981,7 +982,7 @@ but the rep type is Trep :: Int# -> a -> Void# -> T a Actually, the unboxed part isn't implemented yet! -Not that this representation is still *different* from runtime +Note that this representation is still *different* from runtime representation. (Which is what STG uses after unarise). This is how T would end up being used in STG post-unarise: @@ -1397,7 +1398,7 @@ dataConSourceArity (MkData { dcSourceArity = arity }) = arity -- | Gives the number of actual fields in the /representation/ of the -- data constructor. This may be more than appear in the source code; --- the extra ones are the existentially quantified dictionaries +-- the extra ones are the existentially quantified dictionaries. dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity @@ -1408,8 +1409,10 @@ isNullarySrcDataCon dc = dataConSourceArity dc == 0 -- | Return whether there are any argument types for this 'DataCon's runtime representation type -- See Note [DataCon arities] +-- +-- ROMES: The arity of the runtime representation DOES NOT match the arity of the Core representation, which is what `dataConRepArity` means isNullaryRepDataCon :: DataCon -> Bool -isNullaryRepDataCon dc = dataConRepArity dc == 0 +isNullaryRepDataCon dc = length (filter (not . isZeroBitTy . scaledThing) (dataConRepArgTys dc)) == 0 dataConRepStrictness :: DataCon -> [StrictnessMark] -- ^ Give the demands on the arguments of a @@ -1668,6 +1671,21 @@ dataConOtherTheta dc = dcOtherTheta dc -- | Returns the arg types of the worker, including *all* non-dependent -- evidence, after any flattening has been done and without substituting for -- any type variables +-- +-- In Note [Data constructor workers and wrappers], 'dataConRepArgTys' is +-- mentioned as the arguments of the worker, in contrast with 'dcOrigArgTys' +-- which are the arguments of the wrapper. In this context, it makes sense to +-- consider that coercions should be in the list returned by 'dataConRepArgTys' +-- +-- In Note [Data con representation] it is said the following +-- +-- So whenever this module talks about the representation of a data constructor +-- what it means is the DataCon with all Unpacking having been applied. +-- We can think of this as the Core representation. +-- +-- This means we should be careful NOT to use 'dataConRepArgTys' to determine +-- the number of runtime arguments a function has. +-- filter (not . isZeroBitTy . scaledThing) dataConRepArgTys :: DataCon -> [Scaled Type] dataConRepArgTys (MkData { dcRep = rep , dcEqSpec = eq_spec ===================================== compiler/GHC/Types/RepType.hs-boot ===================================== @@ -0,0 +1,9 @@ +module GHC.Types.RepType where + +import Data.Bool +import GHC.Core.TyCo.Rep (Type) +import GHC.Utils.Misc (HasDebugCallStack) + +isZeroBitTy :: HasDebugCallStack => Type -> Bool + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59234911f3a970b66b2be23324430f4d87ce8689 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59234911f3a970b66b2be23324430f4d87ce8689 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 16:49:01 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 27 Mar 2023 12:49:01 -0400 Subject: [Git][ghc/ghc][wip/T23159] 25 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <6421c8fd78034_13561a4bef74785955b6@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23159 at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - d43e2f39 by Simon Peyton Jones at 2023-03-27T17:50:29+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: T15703 - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/using-warnings.rst - libraries/base/Data/Data.hs - libraries/base/Data/Functor/Compose.hs - libraries/base/Data/IORef.hs - libraries/base/GHC/Conc/Sync.hs - libraries/base/GHC/IORef.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/39ebe00c39818d57e33e53ecc74aa467d96454ee...d43e2f392f767dd563b21cefb6dcfd1c60d102fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/39ebe00c39818d57e33e53ecc74aa467d96454ee...d43e2f392f767dd563b21cefb6dcfd1c60d102fa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 17:46:53 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 27 Mar 2023 13:46:53 -0400 Subject: [Git][ghc/ghc][wip/romes/rep-arity] Account for all VoidRep types on precomputedStaticConInfo Message-ID: <6421d68d3a3c_13561a4d121a046176ef@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/rep-arity at Glasgow Haskell Compiler / GHC Commits: 76b1f647 by romes at 2023-03-27T18:35:41+01:00 Account for all VoidRep types on precomputedStaticConInfo Previously, we were considering coercion values whose unlifted type equality had a zerobit runtime representation (VoidRep) to be constructor arguments when determining whether we should pre-compute a staticConInfo for a data constructor. This made it so that GADT constructors with type-equality constraints that should have no runtime representation actually ended up impacting the code generation. Fixes #23158 - - - - - 3 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - + compiler/GHC/Types/RepType.hs-boot Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -79,6 +79,7 @@ import GHC.Core.TyCo.Subst import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.Multiplicity import {-# SOURCE #-} GHC.Types.TyThing +import {-# SOURCE #-} GHC.Types.RepType (isZeroBitTy) import GHC.Types.FieldLabel import GHC.Types.SourceText import GHC.Core.Class @@ -111,8 +112,8 @@ import Data.List( find ) import Language.Haskell.Syntax.Module.Name {- -Data constructor representation -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Data constructor representation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the following Haskell data type declaration data T = T !Int ![Int] @@ -981,7 +982,7 @@ but the rep type is Trep :: Int# -> a -> Void# -> T a Actually, the unboxed part isn't implemented yet! -Not that this representation is still *different* from runtime +Note that this representation is still *different* from runtime representation. (Which is what STG uses after unarise). This is how T would end up being used in STG post-unarise: @@ -1395,9 +1396,9 @@ dataConSrcBangs = dcSrcBangs dataConSourceArity :: DataCon -> Arity dataConSourceArity (MkData { dcSourceArity = arity }) = arity --- | Gives the number of actual fields in the /representation/ of the --- data constructor. This may be more than appear in the source code; --- the extra ones are the existentially quantified dictionaries +-- | Gives the number of actual fields in the core /representation/ of the data +-- constructor. This may be more than appear in the source code; the extra ones +-- are the existentially quantified dictionaries. dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity @@ -1408,8 +1409,12 @@ isNullarySrcDataCon dc = dataConSourceArity dc == 0 -- | Return whether there are any argument types for this 'DataCon's runtime representation type -- See Note [DataCon arities] +-- ROMES:TODO: I'll improve the comment so this is clearer +-- +-- ROMES: The arity of the runtime representation DOES NOT match the arity of the Core representation, which is what `dataConRepArity` means +-- TODO: Might need caching isNullaryRepDataCon :: DataCon -> Bool -isNullaryRepDataCon dc = dataConRepArity dc == 0 +isNullaryRepDataCon dc = length (filter (not . isZeroBitTy . scaledThing) (dataConRepArgTys dc)) == 0 dataConRepStrictness :: DataCon -> [StrictnessMark] -- ^ Give the demands on the arguments of a @@ -1668,6 +1673,21 @@ dataConOtherTheta dc = dcOtherTheta dc -- | Returns the arg types of the worker, including *all* non-dependent -- evidence, after any flattening has been done and without substituting for -- any type variables +-- +-- In Note [Data constructor workers and wrappers], 'dataConRepArgTys' is +-- mentioned as the arguments of the worker, in contrast with 'dcOrigArgTys' +-- which are the arguments of the wrapper. In this context, it makes sense to +-- consider that coercions should be in the list returned by 'dataConRepArgTys' +-- +-- In Note [Data con representation] it is said the following +-- +-- So whenever this module talks about the representation of a data constructor +-- what it means is the DataCon with all Unpacking having been applied. +-- We can think of this as the Core representation. +-- +-- This means we should be careful NOT to use 'dataConRepArgTys' to determine +-- the number of runtime arguments a function has. +-- filter (not . isZeroBitTy . scaledThing) dataConRepArgTys :: DataCon -> [Scaled Type] dataConRepArgTys (MkData { dcRep = rep , dcEqSpec = eq_spec ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -62,7 +62,7 @@ import GHC.Core.Unfold.Make import GHC.Core.Opt.Simplify.Monad import GHC.Core.Type hiding( substTy ) import GHC.Core.Coercion hiding( substCo ) -import GHC.Core.DataCon ( dataConWorkId, isNullaryRepDataCon ) +import GHC.Core.DataCon ( dataConWorkId, dataConRepArity ) import GHC.Core.Multiplicity import GHC.Core.Opt.ConstantFold @@ -2659,7 +2659,7 @@ mkCase2 mode scrut bndr alts_ty alts DataAlt dc -> mkConApp2 dc (tyConAppArgs (idType bndr)) bs mk_new_bndrs new_bndr (DataAlt dc) - | not (isNullaryRepDataCon dc) + | dataConRepArity dc /= 0 = -- For non-nullary data cons we must invent some fake binders -- See Note [caseRules for dataToTag] in GHC.Core.Opt.ConstantFold do { us <- getUniquesM ===================================== compiler/GHC/Types/RepType.hs-boot ===================================== @@ -0,0 +1,9 @@ +module GHC.Types.RepType where + +import Data.Bool +import GHC.Core.TyCo.Rep (Type) +import GHC.Utils.Misc (HasDebugCallStack) + +isZeroBitTy :: HasDebugCallStack => Type -> Bool + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76b1f647f3da7c54e92a3bc559ce9200c14712fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76b1f647f3da7c54e92a3bc559ce9200c14712fc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 17:50:42 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 27 Mar 2023 13:50:42 -0400 Subject: [Git][ghc/ghc][wip/romes/static-gadt-con-info] Account for all VoidRep types on precomputedStaticConInfo Message-ID: <6421d7721735e_13561a4d1219f0618155@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/static-gadt-con-info at Glasgow Haskell Compiler / GHC Commits: 76b1f647 by romes at 2023-03-27T18:35:41+01:00 Account for all VoidRep types on precomputedStaticConInfo Previously, we were considering coercion values whose unlifted type equality had a zerobit runtime representation (VoidRep) to be constructor arguments when determining whether we should pre-compute a staticConInfo for a data constructor. This made it so that GADT constructors with type-equality constraints that should have no runtime representation actually ended up impacting the code generation. Fixes #23158 - - - - - 3 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - + compiler/GHC/Types/RepType.hs-boot Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -79,6 +79,7 @@ import GHC.Core.TyCo.Subst import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.Multiplicity import {-# SOURCE #-} GHC.Types.TyThing +import {-# SOURCE #-} GHC.Types.RepType (isZeroBitTy) import GHC.Types.FieldLabel import GHC.Types.SourceText import GHC.Core.Class @@ -111,8 +112,8 @@ import Data.List( find ) import Language.Haskell.Syntax.Module.Name {- -Data constructor representation -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Data constructor representation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the following Haskell data type declaration data T = T !Int ![Int] @@ -981,7 +982,7 @@ but the rep type is Trep :: Int# -> a -> Void# -> T a Actually, the unboxed part isn't implemented yet! -Not that this representation is still *different* from runtime +Note that this representation is still *different* from runtime representation. (Which is what STG uses after unarise). This is how T would end up being used in STG post-unarise: @@ -1395,9 +1396,9 @@ dataConSrcBangs = dcSrcBangs dataConSourceArity :: DataCon -> Arity dataConSourceArity (MkData { dcSourceArity = arity }) = arity --- | Gives the number of actual fields in the /representation/ of the --- data constructor. This may be more than appear in the source code; --- the extra ones are the existentially quantified dictionaries +-- | Gives the number of actual fields in the core /representation/ of the data +-- constructor. This may be more than appear in the source code; the extra ones +-- are the existentially quantified dictionaries. dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity @@ -1408,8 +1409,12 @@ isNullarySrcDataCon dc = dataConSourceArity dc == 0 -- | Return whether there are any argument types for this 'DataCon's runtime representation type -- See Note [DataCon arities] +-- ROMES:TODO: I'll improve the comment so this is clearer +-- +-- ROMES: The arity of the runtime representation DOES NOT match the arity of the Core representation, which is what `dataConRepArity` means +-- TODO: Might need caching isNullaryRepDataCon :: DataCon -> Bool -isNullaryRepDataCon dc = dataConRepArity dc == 0 +isNullaryRepDataCon dc = length (filter (not . isZeroBitTy . scaledThing) (dataConRepArgTys dc)) == 0 dataConRepStrictness :: DataCon -> [StrictnessMark] -- ^ Give the demands on the arguments of a @@ -1668,6 +1673,21 @@ dataConOtherTheta dc = dcOtherTheta dc -- | Returns the arg types of the worker, including *all* non-dependent -- evidence, after any flattening has been done and without substituting for -- any type variables +-- +-- In Note [Data constructor workers and wrappers], 'dataConRepArgTys' is +-- mentioned as the arguments of the worker, in contrast with 'dcOrigArgTys' +-- which are the arguments of the wrapper. In this context, it makes sense to +-- consider that coercions should be in the list returned by 'dataConRepArgTys' +-- +-- In Note [Data con representation] it is said the following +-- +-- So whenever this module talks about the representation of a data constructor +-- what it means is the DataCon with all Unpacking having been applied. +-- We can think of this as the Core representation. +-- +-- This means we should be careful NOT to use 'dataConRepArgTys' to determine +-- the number of runtime arguments a function has. +-- filter (not . isZeroBitTy . scaledThing) dataConRepArgTys :: DataCon -> [Scaled Type] dataConRepArgTys (MkData { dcRep = rep , dcEqSpec = eq_spec ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -62,7 +62,7 @@ import GHC.Core.Unfold.Make import GHC.Core.Opt.Simplify.Monad import GHC.Core.Type hiding( substTy ) import GHC.Core.Coercion hiding( substCo ) -import GHC.Core.DataCon ( dataConWorkId, isNullaryRepDataCon ) +import GHC.Core.DataCon ( dataConWorkId, dataConRepArity ) import GHC.Core.Multiplicity import GHC.Core.Opt.ConstantFold @@ -2659,7 +2659,7 @@ mkCase2 mode scrut bndr alts_ty alts DataAlt dc -> mkConApp2 dc (tyConAppArgs (idType bndr)) bs mk_new_bndrs new_bndr (DataAlt dc) - | not (isNullaryRepDataCon dc) + | dataConRepArity dc /= 0 = -- For non-nullary data cons we must invent some fake binders -- See Note [caseRules for dataToTag] in GHC.Core.Opt.ConstantFold do { us <- getUniquesM ===================================== compiler/GHC/Types/RepType.hs-boot ===================================== @@ -0,0 +1,9 @@ +module GHC.Types.RepType where + +import Data.Bool +import GHC.Core.TyCo.Rep (Type) +import GHC.Utils.Misc (HasDebugCallStack) + +isZeroBitTy :: HasDebugCallStack => Type -> Bool + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76b1f647f3da7c54e92a3bc559ce9200c14712fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76b1f647f3da7c54e92a3bc559ce9200c14712fc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 18:39:12 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 27 Mar 2023 14:39:12 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] Add hashes to unit-ids created by hadrian Message-ID: <6421e2d0792e2_13561a4e318ce463411@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: 4528b426 by romes at 2023-03-27T19:37:05+01:00 Add hashes to unit-ids created by hadrian Co-author: @mpickering - - - - - 27 changed files: - hadrian/hadrian.cabal - hadrian/src/Context.hs - hadrian/src/Hadrian/BuildPath.hs - hadrian/src/Hadrian/Haskell/Cabal.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - + hadrian/src/Hadrian/Haskell/Hash.hs - + hadrian/src/Hadrian/Haskell/Hash.hs-boot - hadrian/src/Hadrian/Package.hs - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Register.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Haddock.hs - testsuite/driver/testlib.py - testsuite/tests/backpack/cabal/bkpcabal02/all.T - testsuite/tests/cabal/t18567/all.T - testsuite/tests/driver/T16318/Makefile - testsuite/tests/driver/T18125/Makefile - testsuite/tests/ghci/scripts/Makefile - testsuite/tests/package/T4806a.stderr - testsuite/tests/package/all.T - utils/ghc-pkg/Main.hs Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -55,6 +55,7 @@ executable hadrian , Hadrian.BuildPath , Hadrian.Expression , Hadrian.Haskell.Cabal + , Hadrian.Haskell.Hash , Hadrian.Haskell.Cabal.Type , Hadrian.Haskell.Cabal.Parse , Hadrian.Oracles.ArgsHash @@ -163,6 +164,8 @@ executable hadrian , transformers >= 0.4 && < 0.7 , unordered-containers >= 0.2.1 && < 0.3 , text >= 1.2 && < 3 + , cryptohash-sha256 >= 0.11 && < 0.12 + , base16-bytestring >= 0.1.1 && < 1.1.0.0 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Context.hs ===================================== @@ -70,15 +70,15 @@ distDir st = do hostArch <- cabalArchString <$> setting arch return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version -pkgFileName :: Package -> String -> String -> Action FilePath -pkgFileName package prefix suffix = do - pid <- pkgIdentifier package +pkgFileName :: Context -> Package -> String -> String -> Action FilePath +pkgFileName context package prefix suffix = do + pid <- pkgUnitId context package return $ prefix ++ pid ++ suffix pkgFile :: Context -> String -> String -> Action FilePath pkgFile context at Context {..} prefix suffix = do path <- buildPath context - fileName <- pkgFileName package prefix suffix + fileName <- pkgFileName context package prefix suffix return $ path -/- fileName -- | Path to inplace package configuration file of a given 'Context'. @@ -95,9 +95,9 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile Context {..} = do +pkgHaddockFile context at Context {..} = do root <- buildRoot - version <- pkgIdentifier package + version <- pkgUnitId context package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: @@ -106,7 +106,7 @@ pkgHaddockFile Context {..} = do pkgRegisteredLibraryFile :: Context -> Action FilePath pkgRegisteredLibraryFile context at Context {..} = do libDir <- libPath context - pkgId <- pkgIdentifier package + pkgId <- pkgUnitId context package fileName <- pkgRegisteredLibraryFileName context distDir <- distDir stage return $ if Dynamic `wayUnit` way @@ -115,9 +115,9 @@ pkgRegisteredLibraryFile context at Context {..} = do -- | Just the final filename portion of pkgRegisteredLibraryFile pkgRegisteredLibraryFileName :: Context -> Action FilePath -pkgRegisteredLibraryFileName Context{..} = do +pkgRegisteredLibraryFileName context at Context{..} = do extension <- libsuf stage way - pkgFileName package "libHS" extension + pkgFileName context package "libHS" extension -- | Path to the library file of a given 'Context', e.g.: @@ -136,8 +136,8 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile Context {..} = do - pid <- pkgIdentifier package +pkgConfFile context at Context {..} = do + pid <- pkgUnitId context package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Hadrian/BuildPath.hs ===================================== @@ -110,17 +110,28 @@ parseWayUnit = Parsec.choice , Parsec.char 'l' *> pure Logging ] Parsec. "way unit (thr, debug, dyn, p, l)" --- | Parse a @"pkgname-pkgversion"@ string into the package name and the +-- | Parse a @"pkgname-pkgversion-pkghash"@ string into the package name and the -- integers that make up the package version. -parsePkgId :: Parsec.Parsec String () (String, [Integer]) -parsePkgId = parsePkgId' "" Parsec. "package identifier (-)" +-- +-- If no hash was assigned, an empty string is returned in its place. +parsePkgId :: Parsec.Parsec String () (String, [Integer], String) +parsePkgId = parsePkgId' "" Parsec. "package identifier (-(-?))" where parsePkgId' currName = do s <- Parsec.many1 Parsec.alphaNum _ <- Parsec.char '-' let newName = if null currName then s else currName ++ "-" ++ s - Parsec.choice [ (newName,) <$> parsePkgVersion - , parsePkgId' newName ] + Parsec.choice + [ (,,) newName <$> parsePkgVersion + <*> Parsec.option "" (Parsec.try $ do + _ <- Parsec.char '-' + -- Ensure we're not parsing a libDynName as a hash + _ <- Parsec.notFollowedBy (Parsec.string "ghc" *> parsePkgVersion) + parsePkgHash) + , parsePkgId' newName ] + +parsePkgHash :: Parsec.Parsec String () String +parsePkgHash = Parsec.many1 Parsec.alphaNum -- | Parse "."-separated integers that describe a package's version. parsePkgVersion :: Parsec.Parsec String () [Integer] ===================================== hadrian/src/Hadrian/Haskell/Cabal.hs ===================================== @@ -10,8 +10,8 @@ -- Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal ( - pkgVersion, pkgIdentifier, pkgSynopsis, pkgDescription, pkgDependencies, - pkgGenericDescription, cabalArchString, cabalOsString, + pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, pkgSimpleIdentifier, + pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString ) where import Development.Shake @@ -20,15 +20,19 @@ import Distribution.PackageDescription (GenericPackageDescription) import Hadrian.Haskell.Cabal.Type import Hadrian.Oracles.Cabal import Hadrian.Package +import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId) + -- | Read a Cabal file and return the package version. The Cabal file is tracked. pkgVersion :: Package -> Action String pkgVersion = fmap version . readPackageData --- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0 at . +-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at . -- The Cabal file is tracked. -pkgIdentifier :: Package -> Action String -pkgIdentifier package = do +-- +-- For an identifier complete with the hash use 'pkgUnitId' +pkgSimpleIdentifier :: Package -> Action String +pkgSimpleIdentifier package = do cabal <- readPackageData package return $ if null (version cabal) then name cabal @@ -72,3 +76,4 @@ cabalOsString "mingw32" = "windows" cabalOsString "darwin" = "osx" cabalOsString "solaris2" = "solaris" cabalOsString other = other + ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -345,7 +345,7 @@ registerPackage rs context = do pd <- packageDescription <$> readContextData context db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context)) dist_dir <- Context.buildPath context - pid <- pkgIdentifier (package context) + pid <- pkgUnitId context (package context) -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path -- from the local build info @lbi at . lbi <- liftIO $ C.getPersistBuildConfig cPath @@ -357,12 +357,12 @@ registerPackage rs context = do -- This is copied and simplified from Cabal, because we want to install the package -- into a different package database to the one it was configured against. register :: FilePath - -> FilePath + -> String -- ^ Package Identifier -> FilePath -> C.PackageDescription -> LocalBuildInfo -> IO () -register pkg_db conf_file build_dir pd lbi +register pkg_db pid build_dir pd lbi = withLibLBI pd lbi $ \lib clbi -> do absPackageDBs <- C.absolutePackageDBPaths packageDbs @@ -373,13 +373,13 @@ register pkg_db conf_file build_dir pd lbi writeRegistrationFile installedPkgInfo where - regFile = conf_file + regFile = pkg_db pid <.> "conf" reloc = relocatable lbi -- Using a specific package db here is why we have to copy the function from Cabal. packageDbs = [C.SpecificPackageDB pkg_db] writeRegistrationFile installedPkgInfo = do - writeUTF8File (pkg_db regFile <.> "conf") (CP.showInstalledPackageInfo installedPkgInfo) + writeUTF8File regFile (CP.showInstalledPackageInfo installedPkgInfo) -- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs at . ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -0,0 +1,230 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where + +import Development.Shake + +import Hadrian.Haskell.Cabal.Type +import Hadrian.Haskell.Cabal +import Hadrian.Oracles.Cabal +import Hadrian.Package + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as BS +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import Data.List +import Context.Type +import Oracles.Setting +import Hadrian.Target +import Hadrian.Expression +import Builder +import Flavour.Type +import Settings +import Way.Type +import Way +import Packages +import Development.Shake.Classes +import Control.Monad + + +-- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd at . +-- This needs to be an oracle so it's cached +pkgUnitId :: Context -> Package -> Action String +pkgUnitId ctx' pkg = do + let ctx = ctx'{package = pkg} + pid <- pkgSimpleIdentifier (package ctx) + phash <- pkgHash ctx + if pkgName pkg == "rts" + -- The unit-id will change depending on the way, we need to treat the rts separately + then pure pid + else do + -- Other boot packages still hardcode their unit-id to just , but we + -- can have hadrian generate a different unit-id for them just as cabal does + -- because the boot packages unit-ids are overriden by setting -this-unit-id + -- in the cabal file + pure $ pid <> "-" <> truncateHash 4 phash + + where + truncateHash :: Int -> String -> String + truncateHash = take + +data PackageHashInputs = PackageHashInputs { + pkgHashPkgId :: String, -- ^ name-version + pkgHashComponent :: PackageType, + pkgHashSourceHash :: BS.ByteString, + -- pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion), + pkgHashDirectDeps :: Set.Set String, + pkgHashOtherConfig :: PackageHashConfigInputs + } + +-- | Those parts of the package configuration that contribute to the +-- package hash computed by hadrian (which is simpler than cabal's). +-- +-- setting in Oracle.setting, which come from system.config +data PackageHashConfigInputs = PackageHashConfigInputs { + pkgHashCompilerId :: String, + pkgHashPlatform :: String, + pkgHashFlagAssignment :: [String], -- complete not partial + -- pkgHashConfigureScriptArgs :: [String], -- just ./configure for build-type Configure + pkgHashVanillaLib :: Bool, + pkgHashSharedLib :: Bool, + pkgHashDynExe :: Bool, + pkgHashFullyStaticExe :: Bool, + pkgHashGHCiLib :: Bool, + pkgHashProfLib :: Bool, + pkgHashProfExe :: Bool, +-- pkgHashProfLibDetail :: ProfDetailLevel, +-- pkgHashProfExeDetail :: ProfDetailLevel, + pkgHashCoverage :: Bool, + pkgHashOptimization :: Int, + pkgHashSplitObjs :: Bool, + pkgHashSplitSections :: Bool, + pkgHashStripLibs :: Bool, + pkgHashStripExes :: Bool, +-- pkgHashDebugInfo :: DebugInfoLevel, + pkgHashProgramArgs :: Map String [String], + pkgHashExtraLibDirs :: [FilePath], + pkgHashExtraLibDirsStatic :: [FilePath], + pkgHashExtraFrameworkDirs :: [FilePath], + pkgHashExtraIncludeDirs :: [FilePath] + -- pkgHashProgPrefix :: Maybe PathTemplate, + -- pkgHashProgSuffix :: Maybe PathTemplate, + -- pkgHashPackageDbs :: [Maybe PackageDB] + } + deriving Show + +newtype PkgHashKey = PkgHashKey Context + deriving (Binary, Eq, Hashable, NFData, Show, Typeable) +type instance RuleResult PkgHashKey = String + +pkgHash :: Context -> Action String +pkgHash = askOracle . PkgHashKey + +-- Needs to be an oracle to be cached. Called lots of times. +pkgHashOracle :: Rules () +pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do + pkg_data <- readPackageData (package ctx) + name <- pkgSimpleIdentifier (package ctx) + let stag = stage ctx + stagePkgs <- stagePackages stag + depsHashes <- mapM (\pkg -> pkgHash (ctx { package = pkg })) [pkg | pkg <- packageDependencies pkg_data, pkg `elem` stagePkgs] + flav <- flavour + let flavourArgs = args flav + + targetOs <- setting TargetOs + let pkgHashCompilerId = "" + pkgHashPlatform = targetOs + libWays <- interpretInContext ctx (libraryWays flav) + dyn_ghc <- dynamicGhcPrograms flav + flags <- interpret (target ctx (Cabal Flags stag) [] []) flavourArgs + let pkgHashFlagAssignment = flags + pkgHashConfigureScriptArgs = "" + pkgHashVanillaLib = vanilla `Set.member` libWays + pkgHashSharedLib = dynamic `Set.member` libWays + pkgHashDynExe = dyn_ghc + pkgHashFullyStaticExe = False -- TODO: fullyStatic flavour transformer + pkgHashGHCiLib = False + pkgHashProfLib = profiling `Set.member` libWays + pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag + pkgHashCoverage = False -- Can't configure this + pkgHashOptimization = 0 -- TODO: A bit tricky to configure + pkgHashSplitObjs = False -- Deprecated + pkgHashSplitSections = ghcSplitSections flav + pkgHashStripExes = False + pkgHashStripLibs = False + pkgHashDebugInfo = undefined + + -- ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs + let pkgHashProgramArgs = mempty -- TODO: Map.singleton "ghc" ghcArgs, + -- but the above call to 'interpret' causes a + -- build-time loop + pkgHashExtraLibDirs = [] + pkgHashExtraLibDirsStatic = [] + pkgHashExtraFrameworkDirs = [] + pkgHashExtraIncludeDirs = [] + + let other_config = PackageHashConfigInputs{..} + + return $ BS.unpack $ Base16.encode $ SHA256.hash $ + renderPackageHashInputs $ PackageHashInputs + { + pkgHashPkgId = name + , pkgHashComponent = pkgType (package ctx) + , pkgHashSourceHash = "" + , pkgHashDirectDeps = Set.fromList depsHashes + , pkgHashOtherConfig = other_config + } + +prettyShow, showHashValue :: Show a => a -> String +prettyShow = show +showHashValue = show + +renderPackageHashInputs :: PackageHashInputs -> BS.ByteString +renderPackageHashInputs PackageHashInputs{ + pkgHashPkgId, + pkgHashComponent, + pkgHashSourceHash, + pkgHashDirectDeps, + -- pkgHashPkgConfigDeps, + pkgHashOtherConfig = + PackageHashConfigInputs{..} + } = + -- The purpose of this somewhat laboured rendering (e.g. why not just + -- use show?) is so that existing package hashes do not change + -- unnecessarily when new configuration inputs are added into the hash. + BS.pack $ unlines $ catMaybes $ + [ entry "pkgid" prettyShow pkgHashPkgId +-- , mentry "component" show pkgHashComponent + , entry "src" showHashValue pkgHashSourceHash + {- + , entry "pkg-config-deps" + (intercalate ", " . map (\(pn, mb_v) -> prettyShow pn ++ + case mb_v of + Nothing -> "" + Just v -> " " ++ prettyShow v) + . Set.toList) pkgHashPkgConfigDeps + -} + , entry "deps" (intercalate ", " . map prettyShow + . Set.toList) pkgHashDirectDeps + -- and then all the config + , entry "compilerid" prettyShow pkgHashCompilerId + , entry "platform" prettyShow pkgHashPlatform + , opt "flags" mempty show pkgHashFlagAssignment +-- , opt "configure-script" [] unwords pkgHashConfigureScriptArgs + , opt "vanilla-lib" True prettyShow pkgHashVanillaLib + , opt "shared-lib" False prettyShow pkgHashSharedLib + , opt "dynamic-exe" False prettyShow pkgHashDynExe + , opt "fully-static-exe" False prettyShow pkgHashFullyStaticExe + , opt "ghci-lib" False prettyShow pkgHashGHCiLib + , opt "prof-lib" False prettyShow pkgHashProfLib + , opt "prof-exe" False prettyShow pkgHashProfExe + -- , opt "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail + -- , opt "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail + , opt "hpc" False prettyShow pkgHashCoverage + , opt "optimisation" 0 (show) pkgHashOptimization + , opt "split-objs" False prettyShow pkgHashSplitObjs + , opt "split-sections" False prettyShow pkgHashSplitSections + , opt "stripped-lib" False prettyShow pkgHashStripLibs + , opt "stripped-exe" True prettyShow pkgHashStripExes +-- , opt "debug-info" NormalDebugInfo (show . fromEnum) pkgHashDebugInfo + , opt "extra-lib-dirs" [] unwords pkgHashExtraLibDirs + , opt "extra-lib-dirs-static" [] unwords pkgHashExtraLibDirsStatic + , opt "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs + , opt "extra-include-dirs" [] unwords pkgHashExtraIncludeDirs +-- , opt "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix +-- , opt "prog-suffix" Nothing (maybe "" fromPathTemplate) pkgHashProgSuffix +-- , opt "package-dbs" [] (unwords . map show) pkgHashPackageDbs + + ] ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs + where + entry key format value = Just (key ++ ": " ++ format value) + mentry key format value = fmap (\v -> key ++ ": " ++ format v) value + opt key def format value + | value == def = Nothing + | otherwise = entry key format value ===================================== hadrian/src/Hadrian/Haskell/Hash.hs-boot ===================================== @@ -0,0 +1,8 @@ +module Hadrian.Haskell.Hash where + +import Context.Type +import Hadrian.Package +import Development.Shake + +pkgUnitId :: Context -> Package -> Action String + ===================================== hadrian/src/Hadrian/Package.hs ===================================== @@ -81,4 +81,4 @@ instance NFData PackageType instance Binary Package instance Hashable Package -instance NFData Package \ No newline at end of file +instance NFData Package ===================================== hadrian/src/Rules.hs ===================================== @@ -8,6 +8,7 @@ import qualified Hadrian.Oracles.Cabal.Rules import qualified Hadrian.Oracles.DirectoryContents import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile +import qualified Hadrian.Haskell.Hash import Expression import qualified Oracles.Flavour @@ -142,6 +143,7 @@ oracleRules :: Rules () oracleRules = do Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs Hadrian.Oracles.Cabal.Rules.cabalOracle + Hadrian.Haskell.Hash.pkgHashOracle Hadrian.Oracles.DirectoryContents.directoryContentsOracle Hadrian.Oracles.Path.pathOracle Hadrian.Oracles.TextFile.textFileOracle ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -132,7 +132,8 @@ bindistRules = do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -10,7 +10,7 @@ import Utilities import qualified System.Directory.Extra as IO import Data.Either import Rules.BinaryDist -import Hadrian.Haskell.Cabal (pkgIdentifier) +import Hadrian.Haskell.Cabal (pkgUnitId) import Oracles.Setting {- @@ -54,7 +54,8 @@ cabalBuildRules = do need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) distDir <- Context.distDir Stage1 - rtsDir <- pkgIdentifier rts + rtsDir <- pkgUnitId (vanillaContext Stage1 rts) rts + -- let rtsDir = "rts" let ghcBuildDir = root -/- stageString Stage1 rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -293,7 +293,7 @@ parsePkgDocTarget root = do _ <- Parsec.string root *> Parsec.optional (Parsec.char '/') _ <- Parsec.string (htmlRoot ++ "/") _ <- Parsec.string "libraries/" - (pkgname, _) <- parsePkgId <* Parsec.char '/' + (pkgname, _, _) <- parsePkgId <* Parsec.char '/' Parsec.choice [ Parsec.try (Parsec.string "haddock-prologue.txt") *> pure (HaddockPrologue pkgname) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -14,6 +14,7 @@ import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting import Hadrian.Haskell.Cabal.Type (PackageData(version)) +import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal (readPackageData) import Packages import Rules.Libffi @@ -487,16 +488,15 @@ generateConfigHs = do trackGenerateHs cProjectName <- getSetting ProjectName cBooterVersion <- getSetting GhcVersion - cProjectVersionMunged <- getSetting ProjectVersionMunged - -- ROMES:TODO:HASH First we attempt a fixed unit-id with version but without hash. - -- - -- We now use a more informative unit-id for ghc. See Note [GHC's Unit Id] - -- in GHC.Unit.Types + -- We now give a unit-id with a version and a hash to ghc. + -- See Note [GHC's Unit Id] in GHC.Unit.Types -- -- It's crucial that the unit-id matches the unit-key -- ghc is no longer -- part of the WiringMap, so we don't to go back and forth between the - -- unit-id and the unit-key -- we take care here that they are the same. - let cProjectUnitId = "ghc-" ++ cProjectVersionMunged -- ROMES:TODO:HASH + -- unit-id and the unit-key -- we take care that they are the same by using + -- 'pkgUnitId' on 'compiler' (the ghc-library package) to create the + -- unit-id in both situations. + cProjectUnitId <- expr . (`pkgUnitId` compiler) =<< getContext return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -593,3 +593,5 @@ generatePlatformHostHs = do , "hostPlatformArchOS :: ArchOS" , "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS" ] + + ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -45,7 +45,7 @@ libraryRules = do registerStaticLib :: FilePath -> FilePath -> Action () registerStaticLib root archivePath = do -- Simply need the ghc-pkg database .conf file. - GhcPkgPath _ stage _ (LibA name _ w) + GhcPkgPath _ stage _ (LibA name _ _ w) <- parsePath (parseGhcPkgLibA root) "<.a library (register) path parser>" archivePath @@ -56,7 +56,7 @@ registerStaticLib root archivePath = do -- the second argument. buildStaticLib :: FilePath -> FilePath -> Action () buildStaticLib root archivePath = do - l@(BuildPath _ stage _ (LibA pkgname _ way)) + l@(BuildPath _ stage _ (LibA pkgname _ _ way)) <- parsePath (parseBuildLibA root) "<.a library (build) path parser>" archivePath @@ -75,7 +75,7 @@ buildStaticLib root archivePath = do registerDynamicLib :: FilePath -> String -> FilePath -> Action () registerDynamicLib root suffix dynlibpath = do -- Simply need the ghc-pkg database .conf file. - (GhcPkgPath _ stage _ (LibDyn name _ w _)) + (GhcPkgPath _ stage _ (LibDyn name _ _ w _)) <- parsePath (parseGhcPkgLibDyn root suffix) "" dynlibpath @@ -99,7 +99,7 @@ buildDynamicLib root suffix dynlibpath = do -- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. buildGhciLibO :: FilePath -> FilePath -> Action () buildGhciLibO root ghcilibPath = do - l@(BuildPath _ stage _ (LibGhci _ _ _)) + l@(BuildPath _ stage _ (LibGhci _ _ _ _)) <- parsePath (parseBuildLibGhci root) "<.o ghci lib (build) path parser>" ghcilibPath @@ -134,7 +134,7 @@ files etc. buildPackage :: FilePath -> FilePath -> Action () buildPackage root fp = do - l@(BuildPath _ _ _ (PkgStamp _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp + l@(BuildPath _ _ _ (PkgStamp _ _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp let ctx = stampContext l srcs <- hsSources ctx gens <- interpretInContext ctx generatedDependencies @@ -226,47 +226,47 @@ needLibrary cs = need =<< concatMapM (libraryTargets True) cs -- * Library paths types and parsers --- | > libHS-[_].a -data LibA = LibA String [Integer] Way deriving (Eq, Show) +-- | > libHS--[_].a +data LibA = LibA String [Integer] String Way deriving (Eq, Show) -- | > data DynLibExt = So | Dylib deriving (Eq, Show) --- | > libHS-[_]-ghc. -data LibDyn = LibDyn String [Integer] Way DynLibExt deriving (Eq, Show) +-- | > libHS--[_]-ghc. +data LibDyn = LibDyn String [Integer] String Way DynLibExt deriving (Eq, Show) --- | > HS-[_].o -data LibGhci = LibGhci String [Integer] Way deriving (Eq, Show) +-- | > HS--[_].o +data LibGhci = LibGhci String [Integer] String Way deriving (Eq, Show) -- | Get the 'Context' corresponding to the build path for a given static library. libAContext :: BuildPath LibA -> Context -libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) = +libAContext (BuildPath _ stage pkgpath (LibA pkgname _ _ way)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given GHCi library. libGhciContext :: BuildPath LibGhci -> Context -libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) = +libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ _ way)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given dynamic library. libDynContext :: BuildPath LibDyn -> Context -libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = +libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ _ way _)) = Context stage pkg way Final where pkg = library pkgname pkgpath -- | Get the 'Context' corresponding to the build path for a given static library. stampContext :: BuildPath PkgStamp -> Context -stampContext (BuildPath _ stage _ (PkgStamp pkgname _ way)) = +stampContext (BuildPath _ stage _ (PkgStamp pkgname _ _ way)) = Context stage pkg way Final where pkg = unsafeFindPackageByName pkgname -data PkgStamp = PkgStamp String [Integer] Way deriving (Eq, Show) +data PkgStamp = PkgStamp String [Integer] String Way deriving (Eq, Show) -- | Parse a path to a ghci library to be built, making sure the path starts @@ -313,34 +313,34 @@ parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext) parseLibAFilename :: Parsec.Parsec String () LibA parseLibAFilename = do _ <- Parsec.string "libHS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- parseWaySuffix vanilla _ <- Parsec.string ".a" - return (LibA pkgname pkgver way) + return (LibA pkgname pkgver pkghash way) -- | Parse the filename of a ghci library to be built into a 'LibGhci' value. parseLibGhciFilename :: Parsec.Parsec String () LibGhci parseLibGhciFilename = do _ <- Parsec.string "HS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId _ <- Parsec.string "." way <- parseWayPrefix vanilla _ <- Parsec.string "o" - return (LibGhci pkgname pkgver way) + return (LibGhci pkgname pkgver pkghash way) -- | Parse the filename of a dynamic library to be built into a 'LibDyn' value. parseLibDynFilename :: String -> Parsec.Parsec String () LibDyn parseLibDynFilename ext = do _ <- Parsec.string "libHS" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- addWayUnit Dynamic <$> parseWaySuffix dynamic _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion _ <- Parsec.string ("." ++ ext) - return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) + return (LibDyn pkgname pkgver pkghash way $ if ext == "so" then So else Dylib) parseStamp :: Parsec.Parsec String () PkgStamp parseStamp = do _ <- Parsec.string "stamp-" - (pkgname, pkgver) <- parsePkgId + (pkgname, pkgver, pkghash) <- parsePkgId way <- parseWaySuffix vanilla - return (PkgStamp pkgname pkgver way) + return (PkgStamp pkgname pkgver pkghash way) ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeApplications #-} module Rules.Register ( configurePackageRules, registerPackageRules, registerPackages, libraryTargets @@ -20,11 +21,15 @@ import Utilities import Hadrian.Haskell.Cabal.Type import qualified Text.Parsec as Parsec import qualified Data.Set as Set +import qualified Data.Char as Char +import Data.Bifunctor (bimap) import Distribution.Version (Version) -import qualified Distribution.Parsec as Cabal -import qualified Distribution.Types.PackageName as Cabal import qualified Distribution.Types.PackageId as Cabal +import qualified Distribution.Types.PackageName as Cabal +import qualified Distribution.Parsec as Cabal +import qualified Distribution.Parsec.FieldLineStream as Cabal +import qualified Distribution.Compat.CharParsing as CabalCharParsing import qualified Hadrian.Haskell.Cabal.Parse as Cabal import qualified System.Directory as IO @@ -183,7 +188,7 @@ buildConfFinal rs context at Context {..} _conf = do -- so that if any change ends up modifying a library (but not its .conf -- file), we still rebuild things that depend on it. dir <- (-/-) <$> libPath context <*> distDir stage - pkgid <- pkgIdentifier package + pkgid <- pkgUnitId context package files <- liftIO $ (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] @@ -251,11 +256,32 @@ getPackageNameFromConfFile conf takeBaseName conf ++ ": " ++ err Right (name, _) -> return name +-- | Parse a cabal-like name parseCabalName :: String -> Either String (String, Version) -parseCabalName = fmap f . Cabal.eitherParsec +-- Try to parse a name with a hash, but otherwise parse a name without one. +parseCabalName s = bimap show id (Cabal.runParsecParser nameWithHashParser "" $ Cabal.fieldLineStreamFromString s) + <|> fmap f (Cabal.eitherParsec s) where f :: Cabal.PackageId -> (String, Version) f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id) + -- Definition similar to 'Parsec PackageIdentifier' from Cabal but extended + -- with logic for parsing the hash (despite not returning it) + nameWithHashParser :: Cabal.ParsecParser (String, Version) + nameWithHashParser = Cabal.PP $ \_ -> do + xs' <- Parsec.sepBy component (Parsec.char '-') + case reverse xs' of + _hash:version_str:xs -> + case Cabal.simpleParsec @Version version_str of + Nothing -> fail ("failed to parse a version from " <> version_str) + Just v -> + if not (null xs) && all (\c -> all (/= '.') c && not (all Char.isDigit c)) xs + then return $ (intercalate "-" (reverse xs), v) + else fail "all digits or a dot in a portion of package name" + _ -> fail "couldn't parse a hash, a version and a name" + where + component = CabalCharParsing.munch1 (\c -> Char.isAlphaNum c || c == '.') + + -- | Return extra library targets. extraTargets :: Context -> Action [FilePath] ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -84,8 +84,9 @@ cabalSetupArgs = builder (Cabal Setup) ? do commonCabalArgs :: Stage -> Args commonCabalArgs stage = do verbosity <- expr getVerbosity + ctx <- getContext pkg <- getPackage - package_id <- expr $ pkgIdentifier pkg + package_id <- expr $ pkgUnitId ctx pkg let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..") mconcat [ -- Don't strip libraries when cross compiling. -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, @@ -101,7 +102,7 @@ commonCabalArgs stage = do , arg "--cabal-file" , arg $ pkgCabalFile pkg , arg "--ipid" - , arg "$pkg-$version" + , arg package_id , arg "--prefix" , arg prefix ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -243,21 +243,24 @@ wayGhcArgs = do , (way == debug || way == debugDynamic) ? pure ["-ticky", "-DTICKY_TICKY"] ] +-- | Args related to correct handling of packages, such as setting +-- -this-unit-id and passing -package-id for dependencies packageGhcArgs :: Args packageGhcArgs = do package <- getPackage + ctx <- getContext ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage) -- ROMES: Until the boot compiler no longer needs ghc's -- unit-id to be "ghc", the stage0 compiler must be built -- with `-this-unit-id ghc`, while the wired-in unit-id of -- ghc is correctly set to the unit-id we'll generate for - -- stage1 (set in generateVersionHs in Rules.Generate). + -- stage1 (set in generateConfigHs in Rules.Generate). -- -- However, we don't need to set the unit-id of "ghc" to "ghc" when -- building stage0 because we have a flag in compiler/ghc.cabal.in that is -- sets `-this-unit-id ghc` when hadrian is building stage0, which will -- overwrite this one. - pkgId <- expr $ pkgIdentifier package + pkgId <- expr $ pkgUnitId ctx package mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" , arg "-package-env -" ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -42,7 +42,7 @@ haddockBuilderArgs = mconcat version <- expr $ pkgVersion pkg synopsis <- expr $ pkgSynopsis pkg haddocks <- expr $ haddockDependencies context - haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks] + haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgUnitId context p | (p, h) <- haddocks] hVersion <- expr $ pkgVersion haddock statsDir <- expr $ haddockStatsFilesDir baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) ===================================== testsuite/driver/testlib.py ===================================== @@ -930,8 +930,9 @@ def normalise_win32_io_errors(name, opts): def normalise_version_( *pkgs ): def normalise_version__( str ): - return re.sub('(' + '|'.join(map(re.escape,pkgs)) + ')-[0-9.]+(-[0-9a-f]+)?', - '\\1-', str) + # (name)(-version)(-hash)(-components) + return re.sub('(' + '|'.join(map(re.escape,pkgs)) + ')-[0-9.]+(-[0-9a-zA-Z]+)?(-[0-9a-zA-Z]+)?', + '\\1--', str) return normalise_version__ def normalise_version( *pkgs ): ===================================== testsuite/tests/backpack/cabal/bkpcabal02/all.T ===================================== @@ -5,6 +5,6 @@ else: test('bkpcabal02', [extra_files(['p', 'q', 'bkpcabal02.cabal', 'Setup.hs']), - js_broken(22351)], + js_broken(22351), normalise_version('bkpcabal01')], run_command, ['$MAKE -s --no-print-directory bkpcabal02 ' + cleanup]) ===================================== testsuite/tests/cabal/t18567/all.T ===================================== @@ -6,6 +6,7 @@ else: test('T18567', [ extra_files(['Setup.hs', 'sublib/', 'sublib-unused', 'src/', 'internal-lib.cabal']) , js_broken(22356) + , normalise_version('internal-lib') ], run_command, ['$MAKE -s --no-print-directory T18567 ' + cleanup]) ===================================== testsuite/tests/driver/T16318/Makefile ===================================== @@ -5,7 +5,7 @@ include $(TOP)/mk/test.mk test_pe = test-package-environment T16318: - "$(GHC_PKG)" latest base > $(test_pe) + "$(GHC_PKG)" field base id --simple-output > $(test_pe) "$(TEST_HC)" $(TEST_HC_OPTS) -v1 -ignore-dot-ghci -package-env $(test_pe) -e "putStrLn \"Hello\"" > out 2>&1 C=`cat out | grep "Loaded package environment" -c` ; \ if [ $$C != "1" ]; then false; fi ===================================== testsuite/tests/driver/T18125/Makefile ===================================== @@ -6,8 +6,8 @@ test_pe = test-package-environment test_lib = containers T18125: - "$(GHC_PKG)" latest base > $(test_pe) - "$(GHC_PKG)" latest $(test_lib) >> $(test_pe) + "$(GHC_PKG)" field base id --simple-output > $(test_pe) + "$(GHC_PKG)" field $(test_lib) id --simple-outpu >> $(test_pe) "$(TEST_HC)" $(TEST_HC_OPTS) -Wunused-packages -package-env $(test_pe) T18125.hs > out 2>&1 C=`cat out | grep "$(test_lib)" -c` ; \ if [ $$C != "1" ]; then false; fi ===================================== testsuite/tests/ghci/scripts/Makefile ===================================== @@ -69,4 +69,4 @@ T12023: .PHONY: T19650_setup T19650_setup: - '$(GHC_PKG)' latest base > my_package_env + '$(GHC_PKG)' field base id --simple-output > my_package_env ===================================== testsuite/tests/package/T4806a.stderr ===================================== @@ -1,7 +1,7 @@ T4806a.hs:1:1: error: Could not load module ‘Data.Map’ - It is a member of the package ‘containers-0.6.6’ + It is a member of the package ‘containers-0.6.7-4362’ which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies: - deepseq-1.4.8.0 template-haskell-2.20.0.0 + deepseq-1.4.8.1-c027 template-haskell-2.20.0.0-4d68 Use -v (or `:set -v` in ghci) to see a list of the files searched for. ===================================== testsuite/tests/package/all.T ===================================== @@ -19,4 +19,4 @@ test('package09e', normal, compile_fail, ['-package "containers (Data.Map as M, test('package10', normal, compile, ['-hide-all-packages -package "ghc (GHC.Types.Unique.FM as Prelude)" ']) test('T4806', normalise_version('containers'), compile_fail, ['-ignore-package containers']) -test('T4806a', normalise_version('deepseq', 'containers'), compile_fail, ['-ignore-package deepseq']) +test('T4806a', normalise_version('deepseq', 'containers', 'template-haskell'), compile_fail, ['-ignore-package deepseq']) ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -23,6 +23,7 @@ module Main (main) where +import Debug.Trace import qualified GHC.Unit.Database as GhcPkg import GHC.Unit.Database hiding (mkMungePathUrl) import GHC.HandleEncoding @@ -1600,7 +1601,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do simplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO () simplePackageList my_flags pkgs = do let showPkg :: InstalledPackageInfo -> String - showPkg | FlagShowUnitIds `elem` my_flags = display . installedUnitId + showPkg | FlagShowUnitIds `elem` my_flags = traceId . display . installedUnitId | FlagNamesOnly `elem` my_flags = display . mungedName . mungedId | otherwise = display . mungedId strs = map showPkg pkgs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4528b4262fdfaa1dd9cf994e12a2196322f53f72 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4528b4262fdfaa1dd9cf994e12a2196322f53f72 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 20:33:42 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 27 Mar 2023 16:33:42 -0400 Subject: [Git][ghc/ghc][wip/romes/static-gadt-con-info] Account for all VoidRep types on precomputedStaticConInfo Message-ID: <6421fda63a4f3_13561a4ff00d806578a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/static-gadt-con-info at Glasgow Haskell Compiler / GHC Commits: 405c6825 by romes at 2023-03-27T21:33:31+01:00 Account for all VoidRep types on precomputedStaticConInfo Previously, we were considering coercion values whose unlifted type equality had a zerobit runtime representation (VoidRep) to be constructor arguments when determining whether we should pre-compute a staticConInfo for a data constructor. This made it so that GADT constructors with type-equality constraints that should have no runtime representation actually ended up impacting the code generation. Fixes #23158 - - - - - 3 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - + compiler/GHC/Types/RepType.hs-boot Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -79,6 +79,7 @@ import GHC.Core.TyCo.Subst import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.Multiplicity import {-# SOURCE #-} GHC.Types.TyThing +import {-# SOURCE #-} GHC.Types.RepType (isZeroBitTy) import GHC.Types.FieldLabel import GHC.Types.SourceText import GHC.Core.Class @@ -111,8 +112,8 @@ import Data.List( find ) import Language.Haskell.Syntax.Module.Name {- -Data constructor representation -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Data constructor representation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the following Haskell data type declaration data T = T !Int ![Int] @@ -981,7 +982,7 @@ but the rep type is Trep :: Int# -> a -> Void# -> T a Actually, the unboxed part isn't implemented yet! -Not that this representation is still *different* from runtime +Note that this representation is still *different* from runtime representation. (Which is what STG uses after unarise). This is how T would end up being used in STG post-unarise: @@ -1395,9 +1396,9 @@ dataConSrcBangs = dcSrcBangs dataConSourceArity :: DataCon -> Arity dataConSourceArity (MkData { dcSourceArity = arity }) = arity --- | Gives the number of actual fields in the /representation/ of the --- data constructor. This may be more than appear in the source code; --- the extra ones are the existentially quantified dictionaries +-- | Gives the number of actual fields in the core /representation/ of the data +-- constructor. This may be more than appear in the source code; the extra ones +-- are the existentially quantified dictionaries. dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity @@ -1406,10 +1407,14 @@ dataConRepArity (MkData { dcRepArity = arity }) = arity isNullarySrcDataCon :: DataCon -> Bool isNullarySrcDataCon dc = dataConSourceArity dc == 0 --- | Return whether there are any argument types for this 'DataCon's runtime representation type --- See Note [DataCon arities] +-- | Return whether there are any non-zero-width argument types for this +-- 'DataCon's runtime representation type. See Note [DataCon arities] and Note [ +-- ROMES:TODO: I'll improve the comment so this is clearer +-- +-- ROMES: The arity of the runtime representation DOES NOT match the arity of the Core representation, which is what `dataConRepArity` means +-- TODO: Might need caching. The || is to test performance isNullaryRepDataCon :: DataCon -> Bool -isNullaryRepDataCon dc = dataConRepArity dc == 0 +isNullaryRepDataCon dc = dataConRepArity dc == 0 || length (filter (not . isZeroBitTy . scaledThing) (dataConRepArgTys dc)) == 0 dataConRepStrictness :: DataCon -> [StrictnessMark] -- ^ Give the demands on the arguments of a @@ -1668,6 +1673,21 @@ dataConOtherTheta dc = dcOtherTheta dc -- | Returns the arg types of the worker, including *all* non-dependent -- evidence, after any flattening has been done and without substituting for -- any type variables +-- +-- In Note [Data constructor workers and wrappers], 'dataConRepArgTys' is +-- mentioned as the arguments of the worker, in contrast with 'dcOrigArgTys' +-- which are the arguments of the wrapper. In this context, it makes sense to +-- consider that coercions should be in the list returned by 'dataConRepArgTys' +-- +-- In Note [Data con representation] it is said the following +-- +-- So whenever this module talks about the representation of a data constructor +-- what it means is the DataCon with all Unpacking having been applied. +-- We can think of this as the Core representation. +-- +-- This means we should be careful NOT to use 'dataConRepArgTys' to determine +-- the number of runtime arguments a function has. +-- filter (not . isZeroBitTy . scaledThing) dataConRepArgTys :: DataCon -> [Scaled Type] dataConRepArgTys (MkData { dcRep = rep , dcEqSpec = eq_spec ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -62,7 +62,7 @@ import GHC.Core.Unfold.Make import GHC.Core.Opt.Simplify.Monad import GHC.Core.Type hiding( substTy ) import GHC.Core.Coercion hiding( substCo ) -import GHC.Core.DataCon ( dataConWorkId, isNullaryRepDataCon ) +import GHC.Core.DataCon ( dataConWorkId, dataConRepArity ) import GHC.Core.Multiplicity import GHC.Core.Opt.ConstantFold @@ -2659,7 +2659,7 @@ mkCase2 mode scrut bndr alts_ty alts DataAlt dc -> mkConApp2 dc (tyConAppArgs (idType bndr)) bs mk_new_bndrs new_bndr (DataAlt dc) - | not (isNullaryRepDataCon dc) + | dataConRepArity dc /= 0 = -- For non-nullary data cons we must invent some fake binders -- See Note [caseRules for dataToTag] in GHC.Core.Opt.ConstantFold do { us <- getUniquesM ===================================== compiler/GHC/Types/RepType.hs-boot ===================================== @@ -0,0 +1,9 @@ +module GHC.Types.RepType where + +import Data.Bool +import GHC.Core.TyCo.Rep (Type) +import GHC.Utils.Misc (HasDebugCallStack) + +isZeroBitTy :: HasDebugCallStack => Type -> Bool + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/405c6825059a9c071479996025c52227e4aae85c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/405c6825059a9c071479996025c52227e4aae85c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Mar 27 21:08:39 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 27 Mar 2023 17:08:39 -0400 Subject: [Git][ghc/ghc][wip/T23159] Make exprIsConApp_maybe a bit cleverer Message-ID: <642205d7bdc59_13561a50cdb20c66942@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23159 at Glasgow Haskell Compiler / GHC Commits: c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 1 changed file: - compiler/GHC/Core/SimpleOpt.hs Changes: ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -497,13 +497,20 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst }) | otherwise = True -- Unconditionally safe to inline - safe_to_inline :: OccInfo -> Bool - safe_to_inline IAmALoopBreaker{} = False - safe_to_inline IAmDead = True - safe_to_inline OneOcc{ occ_in_lam = NotInsideLam - , occ_n_br = 1 } = True - safe_to_inline OneOcc{} = False - safe_to_inline ManyOccs{} = False +safe_to_inline :: OccInfo -> Bool +safe_to_inline IAmALoopBreaker{} = False +safe_to_inline IAmDead = True +safe_to_inline OneOcc{ occ_in_lam = NotInsideLam + , occ_n_br = 1 } = True +safe_to_inline OneOcc{} = False +safe_to_inline ManyOccs{} = False + +do_beta_by_substitution :: Id -> CoreExpr -> Bool +-- True <=> you can inline (bndr = rhs) by substitution +-- See Note [Exploit occ-info in exprIsConApp_maybe] +do_beta_by_substitution bndr rhs + = exprIsTrivial rhs -- Can duplicate + || safe_to_inline (idOccInfo bndr) -- Occurs at most once ------------------- simple_out_bind :: TopLevelFlag @@ -1078,6 +1085,45 @@ will happen the next time either. See test T16254, which checks the behavior of newtypes. +Note [Exploit occ-info in exprIsConApp_maybe] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose (#23159) we have a simple data constructor wrapper like this (this one +might have come from a data family instance): + $WK x y = K x y |> co +Now suppose the simplifier sees + case ($WK e1 e2) |> co2 of + K p q -> case q of ... + +`exprIsConApp_maybe` expands the wrapper on the fly +(see Note [beta-reduction in exprIsConApp_maybe]). It effectively expands +that ($WK e1 e2) to + let x = e1; y = e2 in K x y |> co + +So the Simplifier might end up producing this: + let x = e1; y = e2 + in case x of ... + +But suppose `q` was used just once in the body of the `K p q` alternative; we +don't want to wait a whole Simplifier iteration to inline that `x`. (e1 might +be another constructor for example.) This would happen if `exprIsConApp_maybe` +we created a let for every (non-trivial) argument. So let's not do that when +the binder is used just once! + +Instead, take advantage of the occurrence-info on `x` and `y` in the unfolding +of `$WK`. Since in `$WK` both `x` and `y` occur once, we want to effectively +expand `($WK e1 e2)` to `(K e1 e2 |> co)`. Hence in +`do_beta_by_substitution` we say "yes" if + + (a) the RHS is trivial (so we can duplicate it); + see call to `exprIsTrivial` +or + (b) the binder occurs at most once (so there is no worry about duplication); + see call to `safe_to_inline`. + +To see this in action, look at testsuite/tests/perf/compiler/T15703. The +initial Simlifier run takes 5 iterations without (b), but only 3 when we add +(b). + Note [Don't float join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ exprIsConApp_maybe should succeed on @@ -1228,7 +1274,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr = go subst floats fun (CC (subst_expr subst arg : args) co) go subst floats (Lam bndr body) (CC (arg:args) co) - | exprIsTrivial arg -- Don't duplicate stuff! + | do_beta_by_substitution bndr arg = go (extend subst bndr arg) floats body (CC args co) | otherwise = let (subst', bndr') = subst_bndr subst bndr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1f755c4bebec04b8942f36c1f2a2a1772dbe28b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1f755c4bebec04b8942f36c1f2a2a1772dbe28b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 08:51:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 28 Mar 2023 04:51:34 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Update and expand atomic modification Haddocks Message-ID: <6422aa96407b2_872874eec77c552ca@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 85387561 by Ryan Scott at 2023-03-28T04:51:27-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 10 changed files: - compiler/GHC/Core/SimpleOpt.hs - libraries/base/Data/Data.hs - libraries/base/Data/IORef.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/IORef.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/changelog.md - + libraries/base/tests/CLC149.hs - libraries/base/tests/all.T Changes: ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -497,13 +497,20 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst }) | otherwise = True -- Unconditionally safe to inline - safe_to_inline :: OccInfo -> Bool - safe_to_inline IAmALoopBreaker{} = False - safe_to_inline IAmDead = True - safe_to_inline OneOcc{ occ_in_lam = NotInsideLam - , occ_n_br = 1 } = True - safe_to_inline OneOcc{} = False - safe_to_inline ManyOccs{} = False +safe_to_inline :: OccInfo -> Bool +safe_to_inline IAmALoopBreaker{} = False +safe_to_inline IAmDead = True +safe_to_inline OneOcc{ occ_in_lam = NotInsideLam + , occ_n_br = 1 } = True +safe_to_inline OneOcc{} = False +safe_to_inline ManyOccs{} = False + +do_beta_by_substitution :: Id -> CoreExpr -> Bool +-- True <=> you can inline (bndr = rhs) by substitution +-- See Note [Exploit occ-info in exprIsConApp_maybe] +do_beta_by_substitution bndr rhs + = exprIsTrivial rhs -- Can duplicate + || safe_to_inline (idOccInfo bndr) -- Occurs at most once ------------------- simple_out_bind :: TopLevelFlag @@ -1078,6 +1085,45 @@ will happen the next time either. See test T16254, which checks the behavior of newtypes. +Note [Exploit occ-info in exprIsConApp_maybe] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose (#23159) we have a simple data constructor wrapper like this (this one +might have come from a data family instance): + $WK x y = K x y |> co +Now suppose the simplifier sees + case ($WK e1 e2) |> co2 of + K p q -> case q of ... + +`exprIsConApp_maybe` expands the wrapper on the fly +(see Note [beta-reduction in exprIsConApp_maybe]). It effectively expands +that ($WK e1 e2) to + let x = e1; y = e2 in K x y |> co + +So the Simplifier might end up producing this: + let x = e1; y = e2 + in case x of ... + +But suppose `q` was used just once in the body of the `K p q` alternative; we +don't want to wait a whole Simplifier iteration to inline that `x`. (e1 might +be another constructor for example.) This would happen if `exprIsConApp_maybe` +we created a let for every (non-trivial) argument. So let's not do that when +the binder is used just once! + +Instead, take advantage of the occurrence-info on `x` and `y` in the unfolding +of `$WK`. Since in `$WK` both `x` and `y` occur once, we want to effectively +expand `($WK e1 e2)` to `(K e1 e2 |> co)`. Hence in +`do_beta_by_substitution` we say "yes" if + + (a) the RHS is trivial (so we can duplicate it); + see call to `exprIsTrivial` +or + (b) the binder occurs at most once (so there is no worry about duplication); + see call to `safe_to_inline`. + +To see this in action, look at testsuite/tests/perf/compiler/T15703. The +initial Simlifier run takes 5 iterations without (b), but only 3 when we add +(b). + Note [Don't float join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ exprIsConApp_maybe should succeed on @@ -1228,7 +1274,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr = go subst floats fun (CC (subst_expr subst arg : args) co) go subst floats (Lam bndr body) (CC (arg:args) co) - | exprIsTrivial arg -- Don't duplicate stuff! + | do_beta_by_substitution bndr arg = go (extend subst bndr arg) floats body (CC args co) | otherwise = let (subst', bndr') = subst_bndr subst bndr ===================================== libraries/base/Data/Data.hs ===================================== @@ -1136,7 +1136,10 @@ consConstr = mkConstr listDataType "(:)" [] Infix listDataType :: DataType listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr] --- | @since 4.0.0.0 +-- | For historical reasons, the constructor name used for @(:)@ is +-- @"(:)"@. In a derived instance, it would be @":"@. +-- +-- @since 4.0.0.0 instance Data a => Data [a] where gfoldl _ z [] = z [] gfoldl f z (x:xs) = z (:) `f` x `f` xs ===================================== libraries/base/Data/IORef.hs ===================================== @@ -85,21 +85,45 @@ modifyIORef' ref f = do -- is recommended that if you need to do anything more complicated -- then using 'Control.Concurrent.MVar.MVar' instead is a good idea. -- --- 'atomicModifyIORef' does not apply the function strictly. This is important --- to know even if all you are doing is replacing the value. For example, this --- will leak memory: +-- Conceptually, -- --- >ref <- newIORef '1' --- >forever $ atomicModifyIORef ref (\_ -> ('2', ())) +-- @ +-- atomicModifyIORef ref f = do +-- -- Begin atomic block +-- old <- 'readIORef' ref +-- let r = f old +-- new = fst r +-- 'writeIORef' ref new +-- -- End atomic block +-- case r of +-- (_new, res) -> pure res +-- @ -- --- Use 'atomicModifyIORef'' or 'atomicWriteIORef' to avoid this problem. +-- The actions in the section labeled \"atomic block\" are not subject to +-- interference from other threads. In particular, it is impossible for the +-- value in the 'IORef' to change between the 'readIORef' and 'writeIORef' +-- invocations. -- --- This function imposes a memory barrier, preventing reordering; --- see "Data.IORef#memmodel" for details. +-- The user-supplied function is applied to the value stored in the 'IORef', +-- yielding a new value to store in the 'IORef' and a value to return. After +-- the new value is (lazily) stored in the 'IORef', @atomicModifyIORef@ forces +-- the result pair, but does not force either component of the result. To force +-- /both/ components, use 'atomicModifyIORef''. +-- +-- Note that +-- +-- @atomicModifyIORef ref (\_ -> undefined)@ +-- +-- will raise an exception in the calling thread, but will /also/ +-- install the bottoming value in the 'IORef', where it may be read by +-- other threads. +-- +-- This function imposes a memory barrier, preventing reordering around the +-- \"atomic block\"; see "Data.IORef#memmodel" for details. -- atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b atomicModifyIORef ref f = do - (_old, ~(_new, res)) <- atomicModifyIORef2 ref f + (_old, (_new, res)) <- atomicModifyIORef2 ref f pure res -- | Variant of 'writeIORef'. The prefix "atomic" relates to a fact that ===================================== libraries/base/Data/Typeable/Internal.hs ===================================== @@ -272,6 +272,7 @@ typeableInstance rep = withTypeable rep TypeableInstance pattern TypeRep :: forall {k :: Type} (a :: k). () => Typeable @k a => TypeRep @k a pattern TypeRep <- (typeableInstance -> TypeableInstance) where TypeRep = typeRep +{-# COMPLETE TypeRep #-} {- Note [TypeRep fingerprints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -134,9 +134,28 @@ atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> data Box a = Box a --- | Strict version of 'Data.IORef.atomicModifyIORef'. This forces both --- the value stored in the 'IORef' and the value returned. The new value --- is installed in the 'IORef' before the returned value is forced. +-- | A strict version of 'Data.IORef.atomicModifyIORef'. This forces both the +-- value stored in the 'IORef' and the value returned. +-- +-- Conceptually, +-- +-- @ +-- atomicModifyIORef' ref f = do +-- -- Begin atomic block +-- old <- 'readIORef' ref +-- let r = f old +-- new = fst r +-- 'writeIORef' ref new +-- -- End atomic block +-- case r of +-- (!_new, !res) -> pure res +-- @ +-- +-- The actions in the \"atomic block\" are not subject to interference +-- by other threads. In particular, the value in the 'IORef' cannot +-- change between the 'readIORef' and 'writeIORef' invocations. +-- +-- The new value is installed in the 'IORef' before either value is forced. -- So -- -- @atomicModifyIORef' ref (\x -> (x+1, undefined))@ @@ -144,8 +163,18 @@ data Box a = Box a -- will increment the 'IORef' and then throw an exception in the calling -- thread. -- --- This function imposes a memory barrier, preventing reordering; --- see "Data.IORef#memmodel" for details. +-- @atomicModifyIORef' ref (\x -> (undefined, x))@ +-- +-- and +-- +-- @atomicModifyIORef' ref (\_ -> undefined)@ +-- +-- will each raise an exception in the calling thread, but will /also/ +-- install the bottoming value in the 'IORef', where it may be read by +-- other threads. +-- +-- This function imposes a memory barrier, preventing reordering around +-- the \"atomic block\"; see "Data.IORef#memmodel" for details. -- -- @since 4.6.0.0 atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -363,6 +363,7 @@ newtype SSymbol (s :: Symbol) = UnsafeSSymbol String pattern SSymbol :: forall s. () => KnownSymbol s => SSymbol s pattern SSymbol <- (knownSymbolInstance -> KnownSymbolInstance) where SSymbol = symbolSing +{-# COMPLETE SSymbol #-} -- An internal data type that is only used for defining the SSymbol pattern -- synonym. @@ -464,6 +465,7 @@ newtype SChar (s :: Char) = UnsafeSChar Char pattern SChar :: forall c. () => KnownChar c => SChar c pattern SChar <- (knownCharInstance -> KnownCharInstance) where SChar = charSing +{-# COMPLETE SChar #-} -- An internal data type that is only used for defining the SChar pattern -- synonym. ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -367,6 +367,7 @@ newtype SNat (n :: Nat) = UnsafeSNat Natural pattern SNat :: forall n. () => KnownNat n => SNat n pattern SNat <- (knownNatInstance -> KnownNatInstance) where SNat = natSing +{-# COMPLETE SNat #-} -- An internal data type that is only used for defining the SNat pattern -- synonym. ===================================== libraries/base/changelog.md ===================================== @@ -16,6 +16,8 @@ ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. ([CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148)) + * Add `COMPLETE` pragmas to the `TypeRep`, `SSymbol`, `SChar`, and `SNat` pattern synonyms. + ([CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149)) ## 4.18.0.0 *TBA* * Shipped with GHC 9.6.1 ===================================== libraries/base/tests/CLC149.hs ===================================== @@ -0,0 +1,23 @@ +-- Test the COMPLETE pragmas for SChar, SNat, SSymbol, and TypeRep. +{-# OPTIONS_GHC -Wincomplete-patterns #-} +module CLC149 where + +import Data.Kind +import GHC.TypeLits +import Type.Reflection + +type Dict :: Constraint -> Type +data Dict c where + Dict :: c => Dict c + +sc :: SChar c -> Dict (KnownChar c) +sc SChar = Dict + +sn :: SNat n -> Dict (KnownNat n) +sn SNat = Dict + +ss :: SSymbol s -> Dict (KnownSymbol s) +ss SSymbol = Dict + +tr :: TypeRep a -> Dict (Typeable a) +tr TypeRep = Dict ===================================== libraries/base/tests/all.T ===================================== @@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('CLC149', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7281d5aa8e7acdae876fab25a27f839efebb80f2...853875613f29e528de65779b1afe41a99eb8c539 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7281d5aa8e7acdae876fab25a27f839efebb80f2...853875613f29e528de65779b1afe41a99eb8c539 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 12:11:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 28 Mar 2023 08:11:48 -0400 Subject: [Git][ghc/ghc][master] Make exprIsConApp_maybe a bit cleverer Message-ID: <6422d98466a07_8728781d65ac843b9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 1 changed file: - compiler/GHC/Core/SimpleOpt.hs Changes: ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -497,13 +497,20 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst }) | otherwise = True -- Unconditionally safe to inline - safe_to_inline :: OccInfo -> Bool - safe_to_inline IAmALoopBreaker{} = False - safe_to_inline IAmDead = True - safe_to_inline OneOcc{ occ_in_lam = NotInsideLam - , occ_n_br = 1 } = True - safe_to_inline OneOcc{} = False - safe_to_inline ManyOccs{} = False +safe_to_inline :: OccInfo -> Bool +safe_to_inline IAmALoopBreaker{} = False +safe_to_inline IAmDead = True +safe_to_inline OneOcc{ occ_in_lam = NotInsideLam + , occ_n_br = 1 } = True +safe_to_inline OneOcc{} = False +safe_to_inline ManyOccs{} = False + +do_beta_by_substitution :: Id -> CoreExpr -> Bool +-- True <=> you can inline (bndr = rhs) by substitution +-- See Note [Exploit occ-info in exprIsConApp_maybe] +do_beta_by_substitution bndr rhs + = exprIsTrivial rhs -- Can duplicate + || safe_to_inline (idOccInfo bndr) -- Occurs at most once ------------------- simple_out_bind :: TopLevelFlag @@ -1078,6 +1085,45 @@ will happen the next time either. See test T16254, which checks the behavior of newtypes. +Note [Exploit occ-info in exprIsConApp_maybe] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose (#23159) we have a simple data constructor wrapper like this (this one +might have come from a data family instance): + $WK x y = K x y |> co +Now suppose the simplifier sees + case ($WK e1 e2) |> co2 of + K p q -> case q of ... + +`exprIsConApp_maybe` expands the wrapper on the fly +(see Note [beta-reduction in exprIsConApp_maybe]). It effectively expands +that ($WK e1 e2) to + let x = e1; y = e2 in K x y |> co + +So the Simplifier might end up producing this: + let x = e1; y = e2 + in case x of ... + +But suppose `q` was used just once in the body of the `K p q` alternative; we +don't want to wait a whole Simplifier iteration to inline that `x`. (e1 might +be another constructor for example.) This would happen if `exprIsConApp_maybe` +we created a let for every (non-trivial) argument. So let's not do that when +the binder is used just once! + +Instead, take advantage of the occurrence-info on `x` and `y` in the unfolding +of `$WK`. Since in `$WK` both `x` and `y` occur once, we want to effectively +expand `($WK e1 e2)` to `(K e1 e2 |> co)`. Hence in +`do_beta_by_substitution` we say "yes" if + + (a) the RHS is trivial (so we can duplicate it); + see call to `exprIsTrivial` +or + (b) the binder occurs at most once (so there is no worry about duplication); + see call to `safe_to_inline`. + +To see this in action, look at testsuite/tests/perf/compiler/T15703. The +initial Simlifier run takes 5 iterations without (b), but only 3 when we add +(b). + Note [Don't float join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ exprIsConApp_maybe should succeed on @@ -1228,7 +1274,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr = go subst floats fun (CC (subst_expr subst arg : args) co) go subst floats (Lam bndr body) (CC (arg:args) co) - | exprIsTrivial arg -- Don't duplicate stuff! + | do_beta_by_substitution bndr arg = go (extend subst bndr arg) floats body (CC args co) | otherwise = let (subst', bndr') = subst_bndr subst bndr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1f755c4bebec04b8942f36c1f2a2a1772dbe28b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1f755c4bebec04b8942f36c1f2a2a1772dbe28b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 12:12:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 28 Mar 2023 08:12:29 -0400 Subject: [Git][ghc/ghc][master] Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat Message-ID: <6422d9ad86b5_8728781d781c87867@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 6 changed files: - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/changelog.md - + libraries/base/tests/CLC149.hs - libraries/base/tests/all.T Changes: ===================================== libraries/base/Data/Typeable/Internal.hs ===================================== @@ -272,6 +272,7 @@ typeableInstance rep = withTypeable rep TypeableInstance pattern TypeRep :: forall {k :: Type} (a :: k). () => Typeable @k a => TypeRep @k a pattern TypeRep <- (typeableInstance -> TypeableInstance) where TypeRep = typeRep +{-# COMPLETE TypeRep #-} {- Note [TypeRep fingerprints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -363,6 +363,7 @@ newtype SSymbol (s :: Symbol) = UnsafeSSymbol String pattern SSymbol :: forall s. () => KnownSymbol s => SSymbol s pattern SSymbol <- (knownSymbolInstance -> KnownSymbolInstance) where SSymbol = symbolSing +{-# COMPLETE SSymbol #-} -- An internal data type that is only used for defining the SSymbol pattern -- synonym. @@ -464,6 +465,7 @@ newtype SChar (s :: Char) = UnsafeSChar Char pattern SChar :: forall c. () => KnownChar c => SChar c pattern SChar <- (knownCharInstance -> KnownCharInstance) where SChar = charSing +{-# COMPLETE SChar #-} -- An internal data type that is only used for defining the SChar pattern -- synonym. ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -367,6 +367,7 @@ newtype SNat (n :: Nat) = UnsafeSNat Natural pattern SNat :: forall n. () => KnownNat n => SNat n pattern SNat <- (knownNatInstance -> KnownNatInstance) where SNat = natSing +{-# COMPLETE SNat #-} -- An internal data type that is only used for defining the SNat pattern -- synonym. ===================================== libraries/base/changelog.md ===================================== @@ -16,6 +16,8 @@ ([CLC proposal #57](https://github.com/haskell/core-libraries-committee/issues/57)) * Add `Eq` and `Ord` instances for `SSymbol`, `SChar`, and `SNat`. ([CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148)) + * Add `COMPLETE` pragmas to the `TypeRep`, `SSymbol`, `SChar`, and `SNat` pattern synonyms. + ([CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149)) ## 4.18.0.0 *TBA* * Shipped with GHC 9.6.1 ===================================== libraries/base/tests/CLC149.hs ===================================== @@ -0,0 +1,23 @@ +-- Test the COMPLETE pragmas for SChar, SNat, SSymbol, and TypeRep. +{-# OPTIONS_GHC -Wincomplete-patterns #-} +module CLC149 where + +import Data.Kind +import GHC.TypeLits +import Type.Reflection + +type Dict :: Constraint -> Type +data Dict c where + Dict :: c => Dict c + +sc :: SChar c -> Dict (KnownChar c) +sc SChar = Dict + +sn :: SNat n -> Dict (KnownNat n) +sn SNat = Dict + +ss :: SSymbol s -> Dict (KnownSymbol s) +ss SSymbol = Dict + +tr :: TypeRep a -> Dict (Typeable a) +tr TypeRep = Dict ===================================== libraries/base/tests/all.T ===================================== @@ -296,3 +296,4 @@ test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) test('listThreads', js_broken(22261), compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) +test('CLC149', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76bb4c586084d7fdcf0e5ce52623abbfca527c55 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76bb4c586084d7fdcf0e5ce52623abbfca527c55 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 13:56:18 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 28 Mar 2023 09:56:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23155 Message-ID: <6422f202cc47e_87287a3b10a01314b6@gitlab.mail> Ben Gamari pushed new branch wip/T23155 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23155 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 15:41:28 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 28 Mar 2023 11:41:28 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/23187 Message-ID: <64230aa88e08b_87287bf3cef01793dc@gitlab.mail> Matthew Pickering pushed new branch wip/23187 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/23187 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 17:22:20 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 28 Mar 2023 13:22:20 -0400 Subject: [Git][ghc/ghc][wip/T13660] base: Ensure that POSIX FilePaths don't contain NULs Message-ID: <6423224c92b11_87287d9699b81952aa@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 47c95cc3 by Ben Gamari at 2023-03-28T09:58:16-04:00 base: Ensure that POSIX FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. Fixes #13660. - - - - - 1 changed file: - libraries/base/System/Posix/Internals.hs Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -164,13 +164,22 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls fp = when ('\0' `elem` fp) (throwInternalNulError fp) #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,13 +187,41 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = + when (cstringLength# str /= len) (throwInternalNulError fp) + -- N.B. If the string contains internal NUL codeunits then the strlen will + -- indicate a size smaller than that returned by withCStringLen. #endif +throwInternalNulError :: FilePath -> IOError +throwInternalNulError fp = ioError err + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "FilePaths must not contain internal NUL code units." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + -- --------------------------------------------------------------------------- -- Terminal-related stuff View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47c95cc3b662c0dd9dc9c116fc360dcf4e47c07e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47c95cc3b662c0dd9dc9c116fc360dcf4e47c07e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 17:31:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 28 Mar 2023 13:31:06 -0400 Subject: [Git][ghc/ghc][wip/T13660] base: Ensure that FilePaths don't contain NULs Message-ID: <6423245a8833b_87287dc63ec0196147@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 521694fc by Ben Gamari at 2023-03-28T13:29:36-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 1 changed file: - libraries/base/System/Posix/Internals.hs Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -43,6 +43,7 @@ import System.IO.Error import GHC.Base import GHC.Num +import GHC.Ptr import GHC.Real import GHC.IO import GHC.IO.IOMode @@ -164,13 +165,22 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls fp = when ('\0' `elem` fp) (throwInternalNulError fp) #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,13 +188,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = + when (len' /= len) (throwInternalNulError fp) + -- N.B. If the string contains internal NUL codeunits then the strlen will + -- indicate a size smaller than that returned by withCStringLen. + where + len' = case str of Ptr ptr -> I# (cstringLength# ptr) #endif +throwInternalNulError :: FilePath -> IO a +throwInternalNulError fp = ioError err + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "FilePaths must not contain internal NUL code units." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + -- --------------------------------------------------------------------------- -- Terminal-related stuff View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/521694fc86f2b6353a2a753833976d13e657763a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/521694fc86f2b6353a2a753833976d13e657763a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 17:37:44 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 28 Mar 2023 13:37:44 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] 6 commits: rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Message-ID: <642325e856daa_87287d9699cc20094e@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - f5ee03fb by Simon Peyton Jones at 2023-03-28T14:47:46+01:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194 - - - - - 18 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1c87de83cfbff51557e7d544f78cfe71f7e812f...f5ee03fbf03dba720bf67cfc87bac1c73839d4c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1c87de83cfbff51557e7d544f78cfe71f7e812f...f5ee03fbf03dba720bf67cfc87bac1c73839d4c5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 18:55:21 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 28 Mar 2023 14:55:21 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Major refactor in the handling of equality constraints Message-ID: <64233819de6ea_87287f5a6cac20831e@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: f274d87e by Simon Peyton Jones at 2023-03-28T19:56:49+01:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194 - - - - - 18 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f274d87ede73079d71d888abcc0c5881971743cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f274d87ede73079d71d888abcc0c5881971743cd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 19:40:07 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 28 Mar 2023 15:40:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23188 Message-ID: <64234297755e7_87287fd329bc22866d@gitlab.mail> Ben Gamari pushed new branch wip/T23188 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23188 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 20:21:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 28 Mar 2023 16:21:33 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 24 commits: Allow WARNING pragmas to be controlled with custom categories Message-ID: <64234c4d9293a_8728710d0b9b02326bc@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 0bfba861 by Ben Gamari at 2023-03-28T16:21:29-04:00 testsuite: Add test for atomicSwapIORef - - - - - da9ec2b0 by Ben Gamari at 2023-03-28T16:21:29-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - 4800dbc7 by Ben Gamari at 2023-03-28T16:21:29-04:00 Make atomicSwapMutVar# an inline primop - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/using-warnings.rst - libraries/base/Data/Data.hs - libraries/base/Data/IORef.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Conc/Sync.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/153b20cb8eed326c965c6963b93a11d1ab4fe38f...4800dbc7a7fd2f2a587c89e51d6bacbe4c8b3fae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/153b20cb8eed326c965c6963b93a11d1ab4fe38f...4800dbc7a7fd2f2a587c89e51d6bacbe4c8b3fae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 20:33:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 28 Mar 2023 16:33:46 -0400 Subject: [Git][ghc/ghc][wip/T23146] 28 commits: Rename () into Unit, (, , ..., , ) into Tuple (#21294) Message-ID: <64234f2ab572c_87287111738cc23332e@gitlab.mail> Ben Gamari pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0680e140 by Ben Gamari at 2023-03-28T14:35:55-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 1fa6cf14 by Ben Gamari at 2023-03-28T14:35:55-04:00 codeGen: Fix some Haddocks - - - - - d067d99b by Ben Gamari at 2023-03-28T14:35:55-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 5551ba68 by romes at 2023-03-28T14:35:55-04:00 Account for all VoidRep types on precomputedStaticConInfo Previously, we were considering coercion values whose unlifted type equality had a zerobit runtime representation (VoidRep) to be constructor arguments when determining whether we should pre-compute a staticConInfo for a data constructor. This made it so that GADT constructors with type-equality constraints that should have no runtime representation actually ended up impacting the code generation. Fixes #23158 - - - - - aae05e9d by Ben Gamari at 2023-03-28T14:42:48-04:00 Check arity before datacon ids TODO: this needs a long note - - - - - 29 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/DataCon.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Monad.hs - compiler/GHC/StgToCmm/Types.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8ce1ba698b0740cf7027efdc5e25d03a836b9a9...aae05e9da8e13e3827c5f1b35dd40ce0bc6745ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8ce1ba698b0740cf7027efdc5e25d03a836b9a9...aae05e9da8e13e3827c5f1b35dd40ce0bc6745ae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 23:03:05 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 28 Mar 2023 19:03:05 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Major refactor in the handling of equality constraints Message-ID: <64237229891a7_872871375a8602564f@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 77b5eb80 by Simon Peyton Jones at 2023-03-28T23:52:43+01:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 18 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77b5eb804b66a28e53a50df43fdc61abed037376 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77b5eb804b66a28e53a50df43fdc61abed037376 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Mar 28 23:09:07 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 28 Mar 2023 19:09:07 -0400 Subject: [Git][ghc/ghc][wip/T23146] 2 commits: Revert "Account for all VoidRep types on precomputedStaticConInfo" Message-ID: <642373937efec_8728713708a742592fc@gitlab.mail> Rodrigo Mesquita pushed to branch wip/T23146 at Glasgow Haskell Compiler / GHC Commits: 5b37b9c6 by Rodrigo Mesquita at 2023-03-29T00:02:59+01:00 Revert "Account for all VoidRep types on precomputedStaticConInfo" This reverts commit 5551ba681e704afccb7d896618b660172ef4c368. - - - - - 8c2a8ae0 by Rodrigo Mesquita at 2023-03-29T00:08:07+01:00 Attempt patch just on mkLFImported, audit isNullaryRepDataCon later. - - - - - 3 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/DataCon.hs Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1397,7 +1397,7 @@ dataConSourceArity (MkData { dcSourceArity = arity }) = arity -- | Gives the number of actual fields in the /representation/ of the -- data constructor. This may be more than appear in the source code; --- the extra ones are the existentially quantified dictionaries. ROMES:TODO: +-- the extra ones are the existentially quantified dictionaries dataConRepArity :: DataCon -> Arity dataConRepArity (MkData { dcRepArity = arity }) = arity ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -24,8 +24,6 @@ module GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, nonVoidIds, nonVoidStgArgs, assertNonVoidIds, assertNonVoidStgArgs, - isStgNullaryDataCon, - -- * LambdaFormInfo LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... @@ -203,18 +201,6 @@ addArgReps = map (\arg -> let arg' = fromNonVoid arg argPrimRep :: StgArg -> PrimRep argPrimRep arg = typePrimRep1 (stgArgType arg) --- | Morally equivalent to @isNullaryRepDataCon con@ at the Stg level, where --- we do not consider types with no runtime representation to be constructor --- arguments. --- --- 'isNullaryRepDataCon' is not fit for checking whether the constructor is --- nullary at the Stg level because the function 'dataConRepArgTys' it --- depends on includes unlifted type equalities, whose runtime --- representation is 'VoidRep', in the returned list. -isStgNullaryDataCon :: DataCon -> Bool -isStgNullaryDataCon = - null . filter (not . isZeroBitTy . scaledThing) . dataConRepArgTys - ------------------------------------------------------ -- Building LambdaFormInfo ------------------------------------------------------ @@ -285,7 +271,7 @@ mkLFImported id = -- Interface doesn't have a LambdaFormInfo, make a conservative one from -- the type. | Just con <- isDataConId_maybe id - , isStgNullaryDataCon con + , length (filter (not . isZeroBitTy . scaledThing) (dataConRepArgTys con)) == 0 -- See Note [Imported nullary datacon wrappers must have correct LFInfo] -- in GHC.StgToCmm.Types -> LFCon con -- An imported nullary constructor ===================================== compiler/GHC/StgToCmm/DataCon.hs ===================================== @@ -327,10 +327,9 @@ because they don't support cross package data references well. precomputedStaticConInfo_maybe :: StgToCmmConfig -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo precomputedStaticConInfo_maybe cfg binder con [] -- Nullary constructors - | isStgNullaryDataCon con + | isNullaryRepDataCon con = Just $ litIdInfo (stgToCmmPlatform cfg) binder (mkConLFInfo con) (CmmLabel (mkClosureLabel (dataConName con) NoCafRefs)) - precomputedStaticConInfo_maybe cfg binder con [arg] -- Int/Char values with existing closures in the RTS | intClosure || charClosure View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aae05e9da8e13e3827c5f1b35dd40ce0bc6745ae...8c2a8ae062abc6a5bb66b8b23881a0a10b568813 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aae05e9da8e13e3827c5f1b35dd40ce0bc6745ae...8c2a8ae062abc6a5bb66b8b23881a0a10b568813 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 07:19:18 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 29 Mar 2023 03:19:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-9.4.5-backports Message-ID: <6423e676e5fee_872871b4f56a82772cb@gitlab.mail> Zubin pushed new branch wip/ghc-9.4.5-backports at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-9.4.5-backports You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 10:14:44 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 29 Mar 2023 06:14:44 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/23184 Message-ID: <64240f9440aaf_3483da2a84e8424414@gitlab.mail> Matthew Pickering pushed new branch wip/23184 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/23184 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 10:50:36 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 29 Mar 2023 06:50:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/23184-9.4 Message-ID: <642417fc9ada8_3483da333478c3314c@gitlab.mail> Matthew Pickering pushed new branch wip/23184-9.4 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/23184-9.4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 12:18:54 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 29 Mar 2023 08:18:54 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Never quantify over equalities in an inferred type Message-ID: <64242caee1675_3483da4e14368509ac@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 312b3975 by Simon Peyton Jones at 2023-03-29T13:18:48+01:00 Never quantify over equalities in an inferred type An experiment.. trying to do the Right Thing! Examples * #22194 * `histogram_` in Statistics.Sample.Histogram in `statistics` - - - - - 1 changed file: - compiler/GHC/Tc/Solver.hs Changes: ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1809,18 +1809,26 @@ decidePromotedTyVars infer_mode name_taus psigs candidates pick :: InferMode -> [PredType] -> TcM ([PredType], [PredType]) -- Split the candidates into ones we definitely -- won't quantify, and ones that we might - pick NoRestrictions cand = return ([], cand) pick ApplyMR cand = return (cand, []) + pick NoRestrictions cand = return (partition is_eq cand) pick EagerDefaulting cand = do { os <- xoptM LangExt.OverloadedStrings ; return (partition (is_int_ct os) cand) } -- For EagerDefaulting, do not quantify over -- over any interactive class constraint is_int_ct ovl_strings pred - | Just (cls, _) <- getClassPredTys_maybe pred - = isInteractiveClass ovl_strings cls - | otherwise - = False + = case classifyPredType pred of + ClassPred cls _ -> isInteractiveClass ovl_strings cls + EqPred {} -> True + IrredPred {} -> True + ForAllPred {} -> True + + is_eq pred + = case classifyPredType pred of + ClassPred {} -> False + EqPred {} -> True + IrredPred {} -> True + ForAllPred {} -> True ------------------- defaultTyVarsAndSimplify :: TcLevel View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/312b39757c5af257985a72d2f29ebed803bc8722 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/312b39757c5af257985a72d2f29ebed803bc8722 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 12:34:43 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 29 Mar 2023 08:34:43 -0400 Subject: [Git][ghc/ghc][wip/T22696] 17 commits: base: Document GHC versions associated with past base versions in the changelog Message-ID: <64243063f2804_3483da4ff39e05698d@gitlab.mail> Ryan Scott pushed to branch wip/T22696 at Glasgow Haskell Compiler / GHC Commits: 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 6ba0aed8 by Ryan Scott at 2023-03-29T08:34:32-04:00 validDerivPred: Reject non-well-formed constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in (VD2) of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if it is, there is a clear migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Validity.hs - docs/users_guide/9.8.1-notes.rst - libraries/base/Data/Data.hs - libraries/base/Data/IORef.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Conc/Sync.hs - libraries/base/GHC/IORef.hs - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/changelog.md - + libraries/base/tests/CLC149.hs - libraries/base/tests/all.T - rts/HsFFI.c - rts/RtsSymbols.c - rts/StgMiscClosures.cmm - + rts/ZeroSlop.c - rts/include/Cmm.h - rts/include/rts/storage/ClosureMacros.h - rts/include/stg/SMP.h - rts/rts.cabal.in - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingMark.c - rts/sm/NonMovingMark.h - rts/sm/Storage.c - testsuite/.gitignore - + testsuite/tests/deriving/should_compile/T22696a.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cc1ddb273c47c07b1835b82c674355e51e2ae23...6ba0aed804d28a19eb10359b8c049b9deadfeb56 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cc1ddb273c47c07b1835b82c674355e51e2ae23...6ba0aed804d28a19eb10359b8c049b9deadfeb56 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 12:35:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 29 Mar 2023 08:35:06 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes] 116 commits: Remove utils/hpc subdirectory and its contents Message-ID: <6424307a8eb71_3483da555377857339@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes at Glasgow Haskell Compiler / GHC Commits: f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f21cdda2 by Ben Gamari at 2023-03-23T13:52:58-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - 25422c95 by Ben Gamari at 2023-03-23T13:52:58-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - f6f970a0 by Ben Gamari at 2023-03-23T13:53:08-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 4acba2b9 by Ben Gamari at 2023-03-23T13:53:08-04:00 compiler: Style fixes - - - - - 966fc49f by Ben Gamari at 2023-03-23T13:53:08-04:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS, but it's a data race nevertheless. - - - - - e1af8be1 by Ben Gamari at 2023-03-23T13:53:08-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 83309b83 by Ben Gamari at 2023-03-23T13:53:08-04:00 Improve TSAN documentation - - - - - b77a065a by Ben Gamari at 2023-03-23T13:53:08-04:00 compiler/cmm: Ensure that dump output has proc name Previously dump output from the early Cmm passes would not be labelled with a proc label. - - - - - 09d2dc92 by Ben Gamari at 2023-03-23T13:53:08-04:00 cmm: Introduce MO_RelaxedRead In hand-written Cmm it can sometimes be necessary to atomically load from memory deep within an expression (e.g. see the `CHECK_GC` macro). This MachOp provides a convenient way to do so without breaking the expression into multiple statements. - - - - - 261c7446 by Ben Gamari at 2023-03-23T13:53:08-04:00 rts: Fix various data races - - - - - d71134af by Ben Gamari at 2023-03-23T13:53:08-04:00 base: use atomic write when updating timer manager - - - - - d8b2cfc4 by Ben Gamari at 2023-03-23T13:53:08-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - 4f18e591 by Ben Gamari at 2023-03-23T13:53:08-04:00 rts: Drop unnecessary atomic - - - - - 41554c8a by Ben Gamari at 2023-03-23T21:00:53-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers - - - - - 78ee2f4f by Ben Gamari at 2023-03-23T22:32:38-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - aac3de58 by Ben Gamari at 2023-03-24T21:39:17-04:00 rts: Fix synchronization on thread blocking state - - - - - 9652ae4a by Ben Gamari at 2023-03-24T21:39:18-04:00 rts: Relaxed load MutVar info table - - - - - d6a10af5 by Ben Gamari at 2023-03-24T21:39:18-04:00 More principled treatment of acquire fences - - - - - 6a742f32 by Ben Gamari at 2023-03-24T21:40:25-04:00 IND - - - - - 1f18678d by Ben Gamari at 2023-03-27T14:46:19-04:00 Wordsmith Note - - - - - b1973bdb by Ben Gamari at 2023-03-27T16:45:25-04:00 Fix thunk update ordering See #23185. - - - - - 61646bbd by Ben Gamari at 2023-03-28T18:36:43-04:00 Use relaxed accesses in ticky bumping - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4a11baffa2f1d02748ddaa00e49bbd7e40d5441...61646bbd8f67f97daa96c7450c00f2511d5ac1f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4a11baffa2f1d02748ddaa00e49bbd7e40d5441...61646bbd8f67f97daa96c7450c00f2511d5ac1f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 12:56:54 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 29 Mar 2023 08:56:54 -0400 Subject: [Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] Fix sed command in install makefile Message-ID: <64243596d95ff_3483da5a6c32c669df@gitlab.mail> Matthew Pickering pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC Commits: bff5210c by GHC GitLab CI at 2023-03-29T12:54:15+00:00 Fix sed command in install makefile - - - - - 1 changed file: - hadrian/bindist/Makefile Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -226,7 +226,7 @@ update_package_db: install_bin install_lib $(INSTALL_DATA) mk/system-cxx-std-lib-1.0.conf "$(DESTDIR)$(ActualLibsDir)/package.conf.d" @echo "Updating the package DB" $(foreach p, $(PKG_CONFS),\ - $(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-\([0-9]*[0-9]\.\)*conf//g'),$(shell echo "$p" | sed 's:\0xxx\0: :g'),$(docdir),$(shell mk/relpath.sh "$(ActualLibsDir)" "$(docdir)"),$(shell echo $(notdir $p) | sed 's/.conf//g'))) + $(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-\([0-9]*[0-9]\.\)*\([0-9]\+\)\(-[0-9a-zA-Z]\+\)*\.conf//g'),$(shell echo "$p" | sed 's:\0xxx\0: :g'),$(docdir),$(shell mk/relpath.sh "$(ActualLibsDir)" "$(docdir)"),$(shell echo $(notdir $p) | sed 's/.conf//g'))) '$(DESTDIR)$(ActualBinsDir)/$(CrossCompilePrefix)ghc-pkg' --global-package-db "$(DESTDIR)$(ActualLibsDir)/package.conf.d" recache install_mingw: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bff5210c4f6781033474b239ac0673bd198ec6b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bff5210c4f6781033474b239ac0673bd198ec6b3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 14:50:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 29 Mar 2023 10:50:06 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] Apply 1 suggestion(s) to 1 file(s) Message-ID: <6424501e523f5_3483da755e5cc9134@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: 271e8a29 by Sylvain Henry at 2023-03-29T14:50:03+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - libraries/base/GHC/IORef.hs Changes: ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -128,8 +128,7 @@ atomicModifyIORef'_ ref f = do -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicSwapMutVar# ref new s of - (# s', old #) -> (# s', old #) +atomicSwapIORef (IORef (STRef ref)) new = IO (atomicSwapMutVar# ref new) -- | A strict version of 'Data.IORef.atomicModifyIORef'. This forces both the -- value stored in the 'IORef' and the value returned. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/271e8a2988add7df70c55c0b9dd37e1bb6f9781f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/271e8a2988add7df70c55c0b9dd37e1bb6f9781f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 14:51:26 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 29 Mar 2023 10:51:26 -0400 Subject: [Git][ghc/ghc][wip/ioref-swap-xchg] 2 commits: compiler: Implement atomicSwapIORef with xchg Message-ID: <6424506ec5f32_3483da755f21095278@gitlab.mail> Ben Gamari pushed to branch wip/ioref-swap-xchg at Glasgow Haskell Compiler / GHC Commits: e0483c86 by Ben Gamari at 2023-03-29T10:51:19-04:00 compiler: Implement atomicSwapIORef with xchg - - - - - 5f22089b by Ben Gamari at 2023-03-29T10:51:19-04:00 Make atomicSwapMutVar# an inline primop - - - - - 5 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/GHC/IORef.hs - rts/include/Cmm.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2537,6 +2537,12 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp has_side_effects = True code_size = { primOpCodeSizeForeignCall } -- for the write barrier +primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp + MutVar# s v -> v -> State# s -> (# State# s, v #) + {Atomically exchange the value of a 'MutVar#'.} + with + has_side_effects = True + -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Looking at the type of atomicModifyMutVar2#, one might wonder why ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -297,16 +297,12 @@ emitPrimOp cfg primop = -- MutVar's value. emitPrimCall [] (MO_AtomicWrite (wordWidth platform) MemOrderRelease) [ cmmOffsetW platform mutv (fixedHdrSizeW profile), var ] + emitDirtyMutVar mutv (CmmReg old_val) - platform <- getPlatform - mkdirtyMutVarCCall <- getCode $! emitCCall - [{-no results-}] - (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) - [(baseExpr platform, AddrHint), (mutv, AddrHint), (CmmReg old_val, AddrHint)] - emit =<< mkCmmIfThen - (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel) - (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutv)) - mkdirtyMutVarCCall + AtomicSwapMutVarOp -> \[mutv, val] -> opIntoRegs $ \[res] -> do + let dst = cmmOffsetW platform mutv (fixedHdrSizeW profile) + emitPrimCall [res] (MO_Xchg (wordWidth platform)) [dst, val] + emitDirtyMutVar mutv (CmmReg (CmmLocal res)) -- #define sizzeofByteArrayzh(r,a) \ -- r = ((StgArrBytes *)(a))->bytes @@ -3232,6 +3228,21 @@ doByteArrayBoundsCheck idx arr idx_ty elem_ty = do (elem_sz - 1) doBoundsCheck idx_bytes sz +-- | Write barrier for @MUT_VAR@ modification. +emitDirtyMutVar :: CmmExpr -> CmmExpr -> FCode () +emitDirtyMutVar mutvar old_val = do + cfg <- getStgToCmmConfig + platform <- getPlatform + mkdirtyMutVarCCall <- getCode $! emitCCall + [{-no results-}] + (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) + [(baseExpr platform, AddrHint), (mutvar, AddrHint), (old_val, AddrHint)] + + emit =<< mkCmmIfThen + (cmmEqWord platform (mkLblExpr mkMUT_VAR_CLEAN_infoLabel) + (closureInfoPtr platform (stgToCmmAlignCheck cfg) mutvar)) + mkdirtyMutVarCCall + --------------------------------------------------------------------------- -- Pushing to the update remembered set --------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -859,6 +859,8 @@ genPrim prof bound ty op = case op of AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f] AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f] + AtomicSwapMutVarOp -> \[r] [mv,v] -> PrimInline $ mconcat + [ r |= mv .^ "val", mv .^ "val" |= v ] CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o) (mconcat [status |= zero_, r |= n, mv .^ "val" |= n]) (mconcat [status |= one_ , r |= mv .^ "val"]) ===================================== libraries/base/GHC/IORef.hs ===================================== @@ -127,12 +127,8 @@ atomicModifyIORef'_ ref f = do -- | Atomically replace the contents of an 'IORef', returning -- the old contents. atomicSwapIORef :: IORef a -> a -> IO a --- Bad implementation! This will be a primop shortly. atomicSwapIORef (IORef (STRef ref)) new = IO $ \s -> - case atomicModifyMutVar2# ref (\_old -> Box new) s of - (# s', old, Box _new #) -> (# s', old #) - -data Box a = Box a +atomicSwapIORef (IORef (STRef ref)) new = IO (atomicSwapMutVar# ref new) -- | A strict version of 'Data.IORef.atomicModifyIORef'. This forces both the -- value stored in the 'IORef' and the value returned. ===================================== rts/include/Cmm.h ===================================== @@ -193,8 +193,10 @@ #if SIZEOF_W == 4 #define cmpxchgW cmpxchg32 +#define xchgW xchg32 #elif SIZEOF_W == 8 #define cmpxchgW cmpxchg64 +#define xchgW xchg64 #endif /* ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/271e8a2988add7df70c55c0b9dd37e1bb6f9781f...5f22089b1c8d7ade8dca8afdd71f11a3e780dc2c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/271e8a2988add7df70c55c0b9dd37e1bb6f9781f...5f22089b1c8d7ade8dca8afdd71f11a3e780dc2c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 15:26:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 29 Mar 2023 11:26:37 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat Message-ID: <642458ad113ad_3483da846c6401074a5@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - ff70afe5 by Matthew Pickering at 2023-03-29T11:26:32-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString/Env.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Load.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/853875613f29e528de65779b1afe41a99eb8c539...ff70afe5f485e0cb904cf54e40d114d45e19a1d9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/853875613f29e528de65779b1afe41a99eb8c539...ff70afe5f485e0cb904cf54e40d114d45e19a1d9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 17:58:24 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Wed, 29 Mar 2023 13:58:24 -0400 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Splitting StackFrames from Closures: Compiles Message-ID: <64247c403d773_3483daac2ac041272e1@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 9da88173 by Sven Tennie at 2023-03-29T17:58:11+00:00 Splitting StackFrames from Closures: Compiles - - - - - 5 changed files: - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/GHC/Exts/Heap/Decode.hs - libraries/ghc-heap/GHC/Exts/Stack/Decode.hs - libraries/ghci/GHCi/Message.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -26,6 +26,7 @@ module GHC.Exts.Heap ( -- * Closure types Closure , GenClosure(..) + , StackFrame(..) , ClosureType(..) , PrimType(..) , WhatNext(..) @@ -138,11 +139,6 @@ instance Double# ~ a => HasHeapRep (a :: TYPE 'DoubleRep) where getClosureData x = return $ DoubleClosure { ptipe = PDouble, doubleVal = D# x } -#if MIN_TOOL_VERSION_ghc(9,7,0) -instance {-# OVERLAPPING #-} HasHeapRep StackSnapshot# where - getClosureData s# = decodeStack (StackSnapshot s#) -#endif - -- | Get the heap representation of a closure _at this moment_, even if it is -- unevaluated or an indirection or other exotic stuff. Beware when passing -- something to this function, the same caveats as for @@ -180,31 +176,9 @@ getClosureDataFromHeapObject x = do getBoxedClosureData :: Box -> IO Closure getBoxedClosureData (Box a) = getClosureData a -#if MIN_TOOL_VERSION_ghc(9,7,0) -getBoxedClosureData b@(StackFrameBox sfi) = trace ("unpack " ++ show b) $ unpackStackFrameIter sfi -#endif - -- | Get the size of the top-level closure in words. -- Includes header and payload. Does not follow pointers. -- -- @since 8.10.1 closureSize :: Box -> IO Int closureSize (Box x) = pure $ I# (closureSize# x) -#if MIN_TOOL_VERSION_ghc(9,7,0) -closureSize (StackFrameBox sfi) = unpackStackFrameIter sfi <&> - \c -> - case c of - UpdateFrame {} -> sizeStgUpdateFrame - CatchFrame {} -> sizeStgCatchFrame - CatchStmFrame {} -> sizeStgCatchSTMFrame - CatchRetryFrame {} -> sizeStgCatchRetryFrame - AtomicallyFrame {} -> sizeStgAtomicallyFrame - RetSmall {..} -> sizeStgClosure + length payload - RetBig {..} -> sizeStgClosure + length payload - RetFun {..} -> sizeStgRetFunFrame + length retFunPayload - -- The one additional word is a pointer to the StgBCO in the closure's payload - RetBCO {..} -> sizeStgClosure + 1 + length bcoArgs - -- The one additional word is a pointer to the next stack chunk - UnderflowFrame {} -> sizeStgClosure + 1 - _ -> error "Unexpected closure type" -#endif ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -11,6 +11,7 @@ module GHC.Exts.Heap.Closures ( -- * Closures Closure , GenClosure(..) + , StackFrame(..) , PrimType(..) , WhatNext(..) , WhyBlocked(..) @@ -22,6 +23,7 @@ module GHC.Exts.Heap.Closures ( , Box(..) , areBoxesEqual , asBox + , StgStackClosure(..) #if MIN_TOOL_VERSION_ghc(9,7,0) , StackFrameIter(..) #endif @@ -50,7 +52,6 @@ import Data.Word import GHC.Exts import GHC.Generics import Numeric - #if MIN_TOOL_VERSION_ghc(9,7,0) import GHC.Stack.CloneStack (StackSnapshot(..), stackSnapshotToString) import GHC.Exts.Stack.Constants @@ -67,11 +68,8 @@ foreign import prim "reallyUnsafePtrEqualityUpToTag" #if MIN_TOOL_VERSION_ghc(9,7,0) -- | Iterator state for stack decoding data StackFrameIter = - -- | Represents a `StackClosure` / @StgStack@ - SfiStackClosure - { stackSnapshot# :: !StackSnapshot# } -- | Represents a closure on the stack - | SfiClosure + SfiClosure { stackSnapshot# :: !StackSnapshot#, index :: !WordOffset } @@ -82,8 +80,6 @@ data StackFrameIter = } instance Eq StackFrameIter where - (SfiStackClosure s1#) == (SfiStackClosure s2#) = - (StackSnapshot s1#) == (StackSnapshot s2#) (SfiClosure s1# i1) == (SfiClosure s2# i2) = (StackSnapshot s1#) == (StackSnapshot s2#) && i1 == i2 @@ -93,34 +89,31 @@ instance Eq StackFrameIter where _ == _ = False instance Show StackFrameIter where - showsPrec _ (SfiStackClosure s#) rs = - "SfiStackClosure { stackSnapshot# = " ++ stackSnapshotToString (StackSnapshot s#) ++ "}" ++ rs showsPrec _ (SfiClosure s# i ) rs = "SfiClosure { stackSnapshot# = " ++ stackSnapshotToString (StackSnapshot s#) ++ show i ++ ", " ++ "}" ++ rs showsPrec _ (SfiPrimitive s# i ) rs = "SfiPrimitive { stackSnapshot# = " ++ stackSnapshotToString (StackSnapshot s#) ++ show i ++ ", " ++ "}" ++ rs --- | An arbitrary Haskell value in a safe Box. --- --- The point is that even unevaluated thunks can safely be moved around inside --- the Box, and when required, e.g. in 'getBoxedClosureData', the function knows --- how far it has to evaluate the argument. --- --- `Box`es can be used to increase (and enforce) laziness: In a graph of --- closures they can act as a barrier of evaluation. `Closure` is an example for --- this. -data Box = - -- | A heap located closure. - Box Any - -- | A value or reference to a value on the stack. - | StackFrameBox StackFrameIter -#else +-- | A value or reference to a value on the stack. +newtype StackFrameBox = StackFrameBox StackFrameIter + deriving (Eq) + +instance Show StackFrameBox where + showsPrec _ (StackFrameBox sfi) rs = + "(StackFrameBox " ++ show sfi ++ ")" ++ rs + +areStackFrameBoxesEqual :: StackFrameBox -> StackFrameBox -> Bool +areStackFrameBoxesEqual (StackFrameBox sfi1) (StackFrameBox sfi2) = + sfi1 == sfi2 +areStackFrameBoxesEqual _ _ = False + +#endif + -- | An arbitrary Haskell value in a safe Box. The point is that even -- unevaluated thunks can safely be moved around inside the Box, and when -- required, e.g. in 'getBoxedClosureData', the function knows how far it has -- to evaluate the argument. data Box = Box Any -#endif instance Show Box where -- From libraries/base/GHC/Ptr.lhs @@ -132,10 +125,6 @@ instance Show Box where tag = ptr .&. fromIntegral tAG_MASK -- ((1 `shiftL` TAG_BITS) -1) addr = ptr - tag pad_out ls = '0':'x':ls -#if MIN_TOOL_VERSION_ghc(9,7,0) - showsPrec _ (StackFrameBox sfi) rs = - "(StackFrameBox " ++ show sfi ++ ")" ++ rs -#endif -- | Boxes can be compared, but this is not pure, as different heap objects can, -- after garbage collection, become the same object. @@ -143,11 +132,6 @@ areBoxesEqual :: Box -> Box -> IO Bool areBoxesEqual (Box a) (Box b) = case reallyUnsafePtrEqualityUpToTag# a b of 0# -> pure False _ -> pure True -#if MIN_TOOL_VERSION_ghc(9,7,0) -areBoxesEqual (StackFrameBox sfi1) (StackFrameBox sfi2) = - pure $ sfi1 == sfi2 -areBoxesEqual _ _ = pure False -#endif -- |This takes an arbitrary value and puts it into a box. -- Note that calls like @@ -163,7 +147,6 @@ asBox x = Box (unsafeCoerce# x) ------------------------------------------------------------------------ -- Closures - type Closure = GenClosure Box -- | This is the representation of a Haskell value on the heap. It reflects @@ -369,74 +352,8 @@ data GenClosure b #if __GLASGOW_HASKELL__ >= 811 , stack_marking :: !Word8 #endif - -- | The frames of the stack. Only available if a cloned stack was - -- decoded, otherwise empty. - , stack :: ![b] - } - -#if MIN_TOOL_VERSION_ghc(9,7,0) - | UpdateFrame - { info :: !StgInfoTable - , updatee :: !b - } - - | CatchFrame - { info :: !StgInfoTable - , exceptions_blocked :: Word - , handler :: !b - } - - | CatchStmFrame - { info :: !StgInfoTable - , catchFrameCode :: !b - , handler :: !b - } - - | CatchRetryFrame - { info :: !StgInfoTable - , running_alt_code :: !Word - , first_code :: !b - , alt_code :: !b } - | AtomicallyFrame - { info :: !StgInfoTable - , atomicallyFrameCode :: !b - , result :: !b - } - - | UnderflowFrame - { info :: !StgInfoTable - , nextChunk :: !b - } - - | StopFrame - { info :: !StgInfoTable } - - | RetSmall - { info :: !StgInfoTable - , payload :: ![b] - } - - | RetBig - { info :: !StgInfoTable - , payload :: ![b] - } - - | RetFun - { info :: !StgInfoTable - , retFunType :: RetFunType - , retFunSize :: Word - , retFunFun :: !b - , retFunPayload :: ![b] - } - - | RetBCO - { info :: !StgInfoTable - , bco :: !b -- must be a BCOClosure - , bcoArgs :: ![b] - } -#endif ------------------------------------------------------------ -- Unboxed unlifted closures @@ -491,7 +408,92 @@ data GenClosure b | UnknownTypeWordSizedPrimitive { wordVal :: !Word } - deriving (Eq, Show, Generic, Functor, Foldable, Traversable) + deriving (Show, Generic, Functor, Foldable, Traversable) + +-- | A decoded @StgStack@ with `StackFrame`s +-- +-- This is separate from it's `Closure` incarnation, as unification would +-- require two kinds of boxes for bitmap encoded stack content: One for +-- primitives and one for closures. This turned out to be a nightmare with lots +-- of pattern matches and leaking data structures to enable access to primitives +-- on the stack... +data StgStackClosure = StgStackClosure + { ssc_info :: !StgInfoTable + , ssc_stack_size :: !Word32 -- ^ stack size in *words* + , ssc_stack_dirty :: !Word8 -- ^ non-zero => dirty + , ssc_stack_marking :: !Word8 + , ssc_stack :: ![StackFrame] + } + deriving Show + +-- | A single stack frame +-- +-- It doesn't use `Box`es because that would require a `Box` constructor for +-- primitive values (bitmap encoded payloads), which introduces lots of pattern +-- matches and complicates the whole implementation (and breaks existing code.) +data StackFrame = + UpdateFrame + { info_tbl :: !StgInfoTable + , updatee :: !Closure + } + + | CatchFrame + { info_tbl :: !StgInfoTable + , exceptions_blocked :: Word + , handler :: !Closure + } + + | CatchStmFrame + { info_tbl :: !StgInfoTable + , catchFrameCode :: !Closure + , handler :: !Closure + } + + | CatchRetryFrame + { info_tbl :: !StgInfoTable + , running_alt_code :: !Word + , first_code :: !Closure + , alt_code :: !Closure + } + + | AtomicallyFrame + { info_tbl :: !StgInfoTable + , atomicallyFrameCode :: !Closure + , result :: !Closure + } + + | UnderflowFrame + { info_tbl :: !StgInfoTable + , nextChunk :: !StgStackClosure + } + + | StopFrame + { info_tbl :: !StgInfoTable } + + | RetSmall + { info_tbl :: !StgInfoTable + , stack_payload :: ![Closure] + } + + | RetBig + { info_tbl :: !StgInfoTable + , stack_payload :: ![Closure] + } + + | RetFun + { info_tbl :: !StgInfoTable + , retFunType :: RetFunType + , retFunSize :: Word + , retFunFun :: !Closure + , retFunPayload :: ![Closure] + } + + | RetBCO + { info_tbl :: !StgInfoTable + , bco :: !Closure -- must be a BCOClosure + , bcoArgs :: ![Closure] + } + deriving (Show, Generic) data RetFunType = ARG_GEN | @@ -592,16 +594,5 @@ allClosures (FunClosure {..}) = ptrArgs allClosures (BlockingQueueClosure {..}) = [link, blackHole, owner, queue] allClosures (WeakClosure {..}) = [cfinalizers, key, value, finalizer] ++ Data.Foldable.toList weakLink allClosures (OtherClosure {..}) = hvalues -#if MIN_TOOL_VERSION_ghc(9,7,0) -allClosures (StackClosure {..}) = stack -allClosures (UpdateFrame {..}) = [updatee] -allClosures (CatchFrame {..}) = [handler] -allClosures (CatchStmFrame {..}) = [catchFrameCode, handler] -allClosures (CatchRetryFrame {..}) = [first_code, alt_code] -allClosures (AtomicallyFrame {..}) = [atomicallyFrameCode, result] -allClosures (RetSmall {..}) = payload -allClosures (RetBig {..}) = payload -allClosures (RetFun {..}) = retFunFun : retFunPayload -allClosures (RetBCO {..}) = bco : bcoArgs -#endif +allClosures (StackClosure {}) = [] allClosures _ = [] ===================================== libraries/ghc-heap/GHC/Exts/Heap/Decode.hs ===================================== @@ -234,7 +234,6 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do #if __GLASGOW_HASKELL__ >= 811 , stack_marking = FFIClosures.stack_marking fields #endif - , stack = [] }) | otherwise -> fail $ "Expected 0 ptr argument to STACK, found " ===================================== libraries/ghc-heap/GHC/Exts/Stack/Decode.hs ===================================== @@ -15,7 +15,6 @@ module GHC.Exts.Stack.Decode ( decodeStack, - unpackStackFrameIter, ) where @@ -29,6 +28,7 @@ import GHC.Exts.Heap.Closures import GHC.Exts.Heap.Constants (wORD_SIZE_IN_BITS) import GHC.Exts.Heap.InfoTable import GHC.Exts.Stack.Constants +import GHC.Exts.Heap.Decode import GHC.IO (IO (..)) import GHC.Stack.CloneStack import GHC.Word @@ -111,37 +111,28 @@ Technical details foreign import prim "getUnderflowFrameNextChunkzh" getUnderflowFrameNextChunk# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, StackSnapshot# #) -getUnderflowFrameNextChunk :: StackFrameIter -> IO StackSnapshot -getUnderflowFrameNextChunk (SfiClosure {..}) = IO $ \s -> +getUnderflowFrameNextChunk :: StackSnapshot# -> WordOffset -> IO StackSnapshot +getUnderflowFrameNextChunk stackSnapshot# index = IO $ \s -> case getUnderflowFrameNextChunk# stackSnapshot# (wordOffsetToWord# index) s of (# s1, stack# #) -> (# s1, StackSnapshot stack# #) -getUnderflowFrameNextChunk sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi foreign import prim "getWordzh" getWord# :: StackSnapshot# -> Word# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) -getWord :: StackFrameIter -> WordOffset -> IO Word -getWord (SfiPrimitive {..}) relativeOffset = IO $ \s -> +getWord :: StackSnapshot# -> WordOffset -> WordOffset -> IO Word +getWord stackSnapshot# index relativeOffset = IO $ \s -> case getWord# stackSnapshot# (wordOffsetToWord# index) (wordOffsetToWord# relativeOffset) s of (# s1, w# #) -> (# s1, W# w# #) -getWord (SfiClosure {..}) relativeOffset = IO $ \s -> - case getWord# - stackSnapshot# - (wordOffsetToWord# index) - (wordOffsetToWord# relativeOffset) - s of - (# s1, w# #) -> (# s1, W# w# #) -getWord sfi _ = error $ "Unexpected StackFrameIter type: " ++ show sfi type WordGetter = StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #) foreign import prim "getRetFunTypezh" getRetFunType# :: WordGetter -getRetFunType :: StackFrameIter -> IO RetFunType -getRetFunType (SfiClosure {..}) = +getRetFunType :: StackSnapshot# -> WordOffset -> IO RetFunType +getRetFunType stackSnapshot# index = toEnum . fromInteger . toInteger <$> IO ( \s -> @@ -151,7 +142,6 @@ getRetFunType (SfiClosure {..}) = s of (# s1, rft# #) -> (# s1, W# rft# #) ) -getRetFunType sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi type LargeBitmapGetter = StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #) @@ -171,29 +161,29 @@ foreign import prim "getInfoTableAddrzh" getInfoTableAddr# :: StackSnapshot# -> foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSnapshot# -> Addr# -getInfoTable :: StackFrameIter -> IO StgInfoTable -getInfoTable SfiClosure {..} = +getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO StgInfoTable +getInfoTableOnStack stackSnapshot# index = let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index)) in peekItbl infoTablePtr -getInfoTable SfiStackClosure {..} = + +getInfoTableForStack :: StackSnapshot# -> IO StgInfoTable +getInfoTableForStack stackSnapshot# = peekItbl $ Ptr (getStackInfoTableAddr# stackSnapshot#) -getInfoTable _ = error "Primitives have no info table!" foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Any #) foreign import prim "getStackFieldszh" getStackFields# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, Word32#, Word8#, Word8# #) -getStackFields :: StackFrameIter -> IO (Word32, Word8, Word8) -getStackFields SfiStackClosure {..} = IO $ \s -> +getStackFields :: StackSnapshot# -> IO (Word32, Word8, Word8) +getStackFields stackSnapshot# = IO $ \s -> case getStackFields# stackSnapshot# s of (# s1, sSize#, sDirty#, sMarking# #) -> (# s1, (W32# sSize#, W8# sDirty#, W8# sMarking#) #) -getStackFields sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi -- | Get an interator starting with the top-most stack frame -stackHead :: StackSnapshot -> StackFrameIter -stackHead (StackSnapshot s) = SfiClosure s 0 -- GHC stacks are never empty +stackHead :: StackSnapshot -> (StackSnapshot, WordOffset) +stackHead (StackSnapshot s#) = (StackSnapshot s#, 0 ) -- GHC stacks are never empty -- | Advance to the next stack frame (if any) -- @@ -202,19 +192,18 @@ stackHead (StackSnapshot s) = SfiClosure s 0 -- GHC stacks are never empty foreign import prim "advanceStackFrameIterzh" advanceStackFrameIter# :: StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #) -- | Advance iterator to the next stack frame (if any) -advanceStackFrameIter :: StackFrameIter -> Maybe StackFrameIter -advanceStackFrameIter (SfiClosure {..}) = +advanceStackFrameIter :: StackSnapshot -> WordOffset -> Maybe (StackSnapshot, WordOffset) +advanceStackFrameIter (StackSnapshot stackSnapshot#) index = let !(# s', i', hasNext #) = advanceStackFrameIter# stackSnapshot# (wordOffsetToWord# index) in if I# hasNext > 0 - then Just $ SfiClosure s' (primWordToWordOffset i') + then Just $ (StackSnapshot s', (primWordToWordOffset i')) else Nothing where primWordToWordOffset :: Word# -> WordOffset primWordToWordOffset w# = fromIntegral (W# w#) -advanceStackFrameIter sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi -getClosure :: StackFrameIter -> WordOffset -> IO Box -getClosure SfiClosure {..} relativeOffset = +getClosure :: StackSnapshot# -> WordOffset -> WordOffset -> IO Box +getClosure stackSnapshot# index relativeOffset = IO $ \s -> case getBoxedClosure# stackSnapshot# @@ -222,15 +211,14 @@ getClosure SfiClosure {..} relativeOffset = s of (# s1, ptr #) -> (# s1, Box ptr #) -getClosure sfi _ = error $ "Unexpected StackFrameIter type: " ++ show sfi -decodeLargeBitmap :: LargeBitmapGetter -> StackFrameIter -> WordOffset -> IO [Box] -decodeLargeBitmap getterFun# sfi@(SfiClosure {..}) relativePayloadOffset = do +decodeLargeBitmap :: LargeBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [Closure] +decodeLargeBitmap getterFun# stackSnapshot# index relativePayloadOffset = do (bitmapArray, size) <- IO $ \s -> case getterFun# stackSnapshot# (wordOffsetToWord# index) s of (# s1, ba#, s# #) -> (# s1, (ByteArray ba#, W# s#) #) let bitmapWords :: [Word] = byteArrayToList bitmapArray - decodeBitmaps sfi relativePayloadOffset bitmapWords size + decodeBitmaps stackSnapshot# index relativePayloadOffset bitmapWords size where byteArrayToList :: ByteArray -> [Word] byteArrayToList (ByteArray bArray) = go 0 @@ -242,16 +230,17 @@ decodeLargeBitmap getterFun# sfi@(SfiClosure {..}) relativePayloadOffset = do sizeofByteArray :: ByteArray# -> Int sizeofByteArray arr# = I# (sizeofByteArray# arr#) -decodeLargeBitmap _ sfi _ = error $ "Unexpected StackFrameIter type: " ++ show sfi -decodeBitmaps :: StackFrameIter -> WordOffset -> [Word] -> Word -> IO [Box] -decodeBitmaps (SfiClosure {..}) relativePayloadOffset bitmapWords size = +decodeBitmaps :: StackSnapshot# -> WordOffset -> WordOffset -> [Word] -> Word -> IO [Closure] +decodeBitmaps stackSnapshot# index relativePayloadOffset bitmapWords size = let bes = wordsToBitmapEntries (index + relativePayloadOffset) bitmapWords size in mapM toBitmapPayload bes where - toBitmapPayload :: StackFrameIter -> IO Box - toBitmapPayload sfi at SfiPrimitive {} = pure (StackFrameBox sfi) - toBitmapPayload sfi at SfiClosure {} = getClosure sfi 0 + toBitmapPayload :: StackFrameIter -> IO Closure + toBitmapPayload sfi at SfiPrimitive {..} = do + w <- getWord stackSnapshot# index 0 + pure $ UnknownTypeWordSizedPrimitive w + toBitmapPayload sfi at SfiClosure {..} = getBoxedClosureData =<< getClosure stackSnapshot# index 0 toBitmapPayload sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi wordsToBitmapEntries :: WordOffset -> [Word] -> Word -> [StackFrameIter] @@ -291,151 +280,144 @@ decodeBitmaps (SfiClosure {..}) relativePayloadOffset bitmapWords size = getIndex (SfiClosure _ i) = i getIndex (SfiPrimitive _ i) = i getIndex sfi' = error $ "Has no index : " ++ show sfi' -decodeBitmaps sfi _ _ _ = error $ "Unexpected StackFrameIter type: " ++ show sfi -decodeSmallBitmap :: SmallBitmapGetter -> StackFrameIter -> WordOffset -> IO [Box] -decodeSmallBitmap getterFun# sfi@(SfiClosure {..}) relativePayloadOffset = +decodeSmallBitmap :: SmallBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [Closure] +decodeSmallBitmap getterFun# stackSnapshot# index relativePayloadOffset = do (bitmap, size) <- IO $ \s -> case getterFun# stackSnapshot# (wordOffsetToWord# index) s of (# s1, b#, s# #) -> (# s1, (W# b#, W# s#) #) let bitmapWords = [bitmap | size > 0] - decodeBitmaps sfi relativePayloadOffset bitmapWords size -decodeSmallBitmap _ sfi _ = - error $ - "Unexpected StackFrameIter type: " ++ show sfi - --- | Decode `StackFrameIter` to `Closure` -unpackStackFrameIter :: StackFrameIter -> IO Closure -unpackStackFrameIter sfi@(SfiPrimitive {}) = - UnknownTypeWordSizedPrimitive - <$> getWord sfi 0 -unpackStackFrameIter sfi@(SfiStackClosure {..}) = do - info <- getInfoTable sfi - (stack_size', stack_dirty', stack_marking') <- getStackFields sfi - case tipe info of - STACK -> do - let stack' = decodeStackToBoxes (StackSnapshot stackSnapshot#) - pure $ - StackClosure - { info = info, - stack_size = stack_size', - stack_dirty = stack_dirty', - stack_marking = stack_marking', - stack = stack' - } - _ -> error $ "Expected STACK closure, got " ++ show info - where - decodeStackToBoxes :: StackSnapshot -> [Box] - decodeStackToBoxes s = - StackFrameBox (stackHead s) - : go (advanceStackFrameIter (stackHead s)) - where - go :: Maybe StackFrameIter -> [Box] - go Nothing = [] - go (Just sfi') = StackFrameBox sfi' : go (advanceStackFrameIter sfi') -unpackStackFrameIter sfi@(SfiClosure {}) = do - info <- getInfoTable sfi - unpackStackFrameIter' info + decodeBitmaps stackSnapshot# index relativePayloadOffset bitmapWords size + +unpackStackFrame :: (StackSnapshot, WordOffset) -> IO StackFrame +unpackStackFrame ((StackSnapshot stackSnapshot#), index) = do + info <- getInfoTableOnStack stackSnapshot# index + unpackStackFrame' info where - unpackStackFrameIter' :: StgInfoTable -> IO Closure - unpackStackFrameIter' info = + unpackStackFrame' :: StgInfoTable -> IO StackFrame + unpackStackFrame' info = case tipe info of RET_BCO -> do - bco' <- getClosure sfi offsetStgClosurePayload + bco' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgClosurePayload -- The arguments begin directly after the payload's one element - bcoArgs' <- decodeLargeBitmap getBCOLargeBitmap# sfi (offsetStgClosurePayload + 1) + bcoArgs' <- decodeLargeBitmap getBCOLargeBitmap# stackSnapshot# index (offsetStgClosurePayload + 1) pure RetBCO - { info = info, + { info_tbl = info, bco = bco', bcoArgs = bcoArgs' } RET_SMALL -> do - payload' <- decodeSmallBitmap getSmallBitmap# sfi offsetStgClosurePayload + payload' <- decodeSmallBitmap getSmallBitmap# stackSnapshot# index offsetStgClosurePayload pure $ RetSmall - { info = info, - payload = payload' + { info_tbl = info, + stack_payload = payload' } RET_BIG -> do - payload' <- decodeLargeBitmap getLargeBitmap# sfi offsetStgClosurePayload + payload' <- decodeLargeBitmap getLargeBitmap# stackSnapshot# index offsetStgClosurePayload pure $ RetBig - { info = info, - payload = payload' + { info_tbl = info, + stack_payload = payload' } RET_FUN -> do - retFunType' <- getRetFunType sfi - retFunSize' <- getWord sfi offsetStgRetFunFrameSize - retFunFun' <- getClosure sfi offsetStgRetFunFrameFun + retFunType' <- getRetFunType stackSnapshot# index + retFunSize' <- getWord stackSnapshot# index offsetStgRetFunFrameSize + retFunFun' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgRetFunFrameFun retFunPayload' <- if retFunType' == ARG_GEN_BIG - then decodeLargeBitmap getRetFunLargeBitmap# sfi offsetStgRetFunFramePayload - else decodeSmallBitmap getRetFunSmallBitmap# sfi offsetStgRetFunFramePayload + then decodeLargeBitmap getRetFunLargeBitmap# stackSnapshot# index offsetStgRetFunFramePayload + else decodeSmallBitmap getRetFunSmallBitmap# stackSnapshot# index offsetStgRetFunFramePayload pure $ RetFun - { info = info, + { info_tbl = info, retFunType = retFunType', retFunSize = retFunSize', retFunFun = retFunFun', retFunPayload = retFunPayload' } UPDATE_FRAME -> do - updatee' <- getClosure sfi offsetStgUpdateFrameUpdatee + updatee' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgUpdateFrameUpdatee pure $ UpdateFrame - { info = info, + { info_tbl = info, updatee = updatee' } CATCH_FRAME -> do - exceptions_blocked' <- getWord sfi offsetStgCatchFrameExceptionsBlocked - handler' <- getClosure sfi offsetStgCatchFrameHandler + exceptions_blocked' <- getWord stackSnapshot# index offsetStgCatchFrameExceptionsBlocked + handler' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgCatchFrameHandler pure $ CatchFrame - { info = info, + { info_tbl = info, exceptions_blocked = exceptions_blocked', handler = handler' } UNDERFLOW_FRAME -> do - (StackSnapshot nextChunk') <- getUnderflowFrameNextChunk sfi + nextChunk' <- getUnderflowFrameNextChunk stackSnapshot# index + stackClosure <- decodeStack nextChunk' pure $ UnderflowFrame - { info = info, - nextChunk = StackFrameBox $ SfiStackClosure nextChunk' + { info_tbl = info, + nextChunk = stackClosure } - STOP_FRAME -> pure $ StopFrame {info = info} + STOP_FRAME -> pure $ StopFrame {info_tbl = info} ATOMICALLY_FRAME -> do - atomicallyFrameCode' <- getClosure sfi offsetStgAtomicallyFrameCode - result' <- getClosure sfi offsetStgAtomicallyFrameResult + atomicallyFrameCode' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgAtomicallyFrameCode + result' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgAtomicallyFrameResult pure $ AtomicallyFrame - { info = info, + { info_tbl = info, atomicallyFrameCode = atomicallyFrameCode', result = result' } CATCH_RETRY_FRAME -> do - running_alt_code' <- getWord sfi offsetStgCatchRetryFrameRunningAltCode - first_code' <- getClosure sfi offsetStgCatchRetryFrameRunningFirstCode - alt_code' <- getClosure sfi offsetStgCatchRetryFrameAltCode + running_alt_code' <- getWord stackSnapshot# index offsetStgCatchRetryFrameRunningAltCode + first_code' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgCatchRetryFrameRunningFirstCode + alt_code' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgCatchRetryFrameAltCode pure $ CatchRetryFrame - { info = info, + { info_tbl = info, running_alt_code = running_alt_code', first_code = first_code', alt_code = alt_code' } CATCH_STM_FRAME -> do - catchFrameCode' <- getClosure sfi offsetStgCatchSTMFrameCode - handler' <- getClosure sfi offsetStgCatchSTMFrameHandler + catchFrameCode' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgCatchSTMFrameCode + handler' <- getBoxedClosureData =<< getClosure stackSnapshot# index offsetStgCatchSTMFrameHandler pure $ CatchStmFrame - { info = info, + { info_tbl = info, catchFrameCode = catchFrameCode', handler = handler' } x -> error $ "Unexpected closure type on stack: " ++ show x +getClosureDataFromHeapObject + :: a + -- ^ Heap object to decode. + -> IO Closure + -- ^ Heap representation of the closure. +getClosureDataFromHeapObject x = do + case unpackClosure# x of + (# infoTableAddr, heapRep, pointersArray #) -> do + let infoTablePtr = Ptr infoTableAddr + ptrList = [case indexArray# pointersArray i of + (# ptr #) -> Box ptr + | I# i <- [0..I# (sizeofArray# pointersArray) - 1] + ] + + infoTable <- peekItbl infoTablePtr + case tipe infoTable of + TSO -> pure $ UnsupportedClosure infoTable + STACK -> pure $ UnsupportedClosure infoTable + _ -> getClosureDataFromHeapRep heapRep infoTablePtr ptrList + +-- | Like 'getClosureData', but taking a 'Box', so it is easier to work with. +getBoxedClosureData :: Box -> IO Closure +getBoxedClosureData (Box a) = getClosureDataFromHeapObject a + -- | Unbox 'Int#' from 'Int' toInt# :: Int -> Int# toInt# (I# i) = i @@ -451,10 +433,36 @@ wordOffsetToWord# wo = intToWord# (fromIntegral wo) -- -- Due to the use of `Box` this decoding is lazy. The first decoded closure is -- the representation of the @StgStack@ itself. -decodeStack :: StackSnapshot -> IO Closure +decodeStack :: StackSnapshot -> IO StgStackClosure decodeStack (StackSnapshot stack#) = - unpackStackFrameIter $ - SfiStackClosure stack# + unpackStack stack# + +unpackStack :: StackSnapshot# -> IO StgStackClosure +unpackStack stack# = do + info <- getInfoTableForStack stack# + (stack_size', stack_dirty', stack_marking') <- getStackFields stack# + case tipe info of + STACK -> do + let sfis = decodeStackToBoxes (StackSnapshot stack#) + stack' <- mapM unpackStackFrame sfis + pure $ + StgStackClosure + { ssc_info = info, + ssc_stack_size = stack_size', + ssc_stack_dirty = stack_dirty', + ssc_stack_marking = stack_marking', + ssc_stack = stack' + } + _ -> error $ "Expected STACK closure, got " ++ show info + where + decodeStackToBoxes :: StackSnapshot -> [(StackSnapshot, WordOffset)] + decodeStackToBoxes s = + (stackHead s) + : go (advanceStackFrameIter (fst (stackHead s)) (snd (stackHead s))) + where + go :: Maybe (StackSnapshot, WordOffset) -> [(StackSnapshot, WordOffset)] + go Nothing = [] + go (Just r) = r : go (advanceStackFrameIter (fst r) (snd r)) #else module GHC.Exts.Stack.Decode where ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -471,14 +471,10 @@ instance Binary Heap.WhyBlocked instance Binary Heap.TsoFlags #endif -#if MIN_VERSION_base(4,17,0) -instance Binary Heap.RetFunType -#endif - instance Binary Heap.StgInfoTable instance Binary Heap.ClosureType instance Binary Heap.PrimType -instance Binary a => Binary (Heap.GenClosure a) +instance (Binary a) => Binary (Heap.GenClosure a) data Msg = forall a . (Binary a, Show a) => Msg (Message a) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9da88173bc5eafe65ee6f338116f60e45df4fd37 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9da88173bc5eafe65ee6f338116f60e45df4fd37 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 18:04:00 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 29 Mar 2023 14:04:00 -0400 Subject: [Git][ghc/ghc][wip/T13660] 30 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <64247d90988f1_3483daacd7f3012797b@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 89dae1c2 by Ben Gamari at 2023-03-29T14:00:27-04:00 base: Add test for #13660 - - - - - 94c808a7 by Ben Gamari at 2023-03-29T14:03:37-04:00 base: Introduce {new,with}CStringLen0 - - - - - 377f6cb4 by Ben Gamari at 2023-03-29T14:03:54-04:00 base: Clean up documentation - - - - - fdee87f9 by Ben Gamari at 2023-03-29T14:03:54-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/using-warnings.rst - libraries/base/Data/Data.hs - libraries/base/Data/Functor/Compose.hs - libraries/base/Data/IORef.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Conc/Sync.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/521694fc86f2b6353a2a753833976d13e657763a...fdee87f9ab056846a8e467741cb836146063e474 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/521694fc86f2b6353a2a753833976d13e657763a...fdee87f9ab056846a8e467741cb836146063e474 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 18:14:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 29 Mar 2023 14:14:46 -0400 Subject: [Git][ghc/ghc][wip/T23155] testsuite: Fix racing prints in T21465 Message-ID: <6424801666231_3483dab195a40130350@gitlab.mail> Ben Gamari pushed to branch wip/T23155 at Glasgow Haskell Compiler / GHC Commits: 6ac4ca8f by Ben Gamari at 2023-03-29T14:14:40-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 3 changed files: - testsuite/tests/rts/T21465/T21465.hs - testsuite/tests/rts/T21465/T21465.stdout - testsuite/tests/rts/T21465/T21465_c.c Changes: ===================================== testsuite/tests/rts/T21465/T21465.hs ===================================== @@ -1,10 +1,12 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Main where +import System.IO + foreign import ccall "test_c" testC :: IO () helper :: IO () -helper = putStrLn "This is the helper function" +helper = putStrLn "This is the helper function" >> hFlush stdout foreign export ccall helper :: IO () ===================================== testsuite/tests/rts/T21465/T21465.stdout ===================================== @@ -1,5 +1,4 @@ This is the helper function -Done. 0: 01 01 1: 02 02 2: 03 03 @@ -16,3 +15,4 @@ Done. 13: 0e 0e 14: 0f 0f 15: 10 10 +Done. ===================================== testsuite/tests/rts/T21465/T21465_c.c ===================================== @@ -25,4 +25,5 @@ void test_c() { for (int i = 0; i < 16; i++) { printf("%2i: %02x %02x\n", i, blah[i], foo[i]); } + fflush(stdout); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ac4ca8f2ccc05dfb75d4625431181d69bbfd41d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ac4ca8f2ccc05dfb75d4625431181d69bbfd41d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 19:37:24 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 29 Mar 2023 15:37:24 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] 2 commits: Typos and comments Message-ID: <642493742888e_3483dac6cc878139312@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 4a359742 by Simon Peyton Jones at 2023-03-29T13:49:02+01:00 Typos and comments - - - - - 8d947c3c by Simon Peyton Jones at 2023-03-29T20:38:36+01:00 Add a type signature in isAtomicHsExpr - - - - - 7 changed files: - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -876,7 +876,7 @@ injectiveVarsOfType look_under_tfs = go filterByList (flags ++ repeat True) tys -- Oversaturated arguments to a tycon are -- always injective, hence the repeat True - | otherwise -- No injectivity for thsi type family + | otherwise -- No injectivity info for this type family -> emptyFV | otherwise -- Data type, injective in all positions ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -838,10 +838,12 @@ data TyConDetails = -- in the RHS (or is mentioned only under -- forgetful synonyms) -- Test is conservative, so True does not guarantee - -- forgetfulness. + -- forgetfulness. False conveys definite information + -- (definitely not forgetful); True is always safe. synIsConcrete :: Bool -- True <= If 'tys' are concrete then the expansion - -- of (S tys) is concrete + -- of (S tys) is definitely concrete + -- But False is always safe } -- | Represents families (both type and data) ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -416,6 +416,10 @@ expandSynTyConApp_maybe tc arg_tys | Just (tvs, rhs) <- synTyConDefn_maybe tc , arg_tys `saturates` tyConArity tc = Just $! (expand_syn tvs rhs arg_tys) + -- Why strict application? Because every client of this function will evaluat + -- that (expand_syn ...) thunk, so it's more efficient not to build a thunk. + -- Mind you, this function is always INLINEd, so the client context is probably + -- enough to avoid thunk construction and so the $! is just belt-and-braces. | otherwise = Nothing @@ -2223,9 +2227,17 @@ buildSynTyCon name binders res_kind roles rhs is_tau = isTauTy rhs is_fam_free = isFamFreeTy rhs is_concrete = uniqSetAll isConcreteTyCon rhs_tycons + -- NB: is_concrete is allowed to be conservative, returning False + -- more often than it could. e.g. + -- type S a b = b + -- type family F a + -- type T a = S (F a) a + -- We will mark T as not-concrete, even though (since S ignore its first + -- argument, it could be marked concrete. + is_forgetful = not (all ((`elemVarSet` rhs_tyvars) . binderVar) binders) || uniqSetAny isForgetfulSynTyCon rhs_tycons - -- NB: This is allowed to be conservative, returning True more often + -- NB: is_forgetful is allowed to be conservative, returning True more often -- than it should. See comments on GHC.Core.TyCon.isForgetfulSynTyCon rhs_tycons = tyConsOfType rhs ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -863,12 +863,16 @@ isAtomicHsExpr (XExpr x) | GhcTc <- ghcPass @p = go_x_tc x | GhcRn <- ghcPass @p = go_x_rn x where + go_x_tc :: XXExprGhcTc -> Bool go_x_tc (WrapExpr (HsWrap _ e)) = isAtomicHsExpr e go_x_tc (ExpansionExpr (HsExpanded a _)) = isAtomicHsExpr a go_x_tc (ConLikeTc {}) = True go_x_tc (HsTick {}) = False go_x_tc (HsBinTick {}) = False + go_x_rn :: HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) -> Bool + -- Without this signature we would have to infer + -- go_x_rn :: forall p2. IsPass p2 => HsExpansion (HsExpr (GhcPass p2)) any -> Bool go_x_rn (HsExpanded a _) = isAtomicHsExpr a isAtomicHsExpr _ = False ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -2296,7 +2296,7 @@ More details: [W] alpha ~ Maybe (F alpha, G beta) We'll end up calling GHC.Tc.Utils.Unify.checkFamApp * On `F alpha`, which fail and calls the cycle-breaker in TEFA_Break - * On `G beta`, which suceeds no problem. + * On `G beta`, which succeeds no problem. However, we make no attempt to detect cases like a ~ (F a, F a) and use the same tyvar to replace F a. The constraint solver will common them up later! ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -2064,7 +2064,7 @@ checkTouchableTyVarEq -> TcTyVar -- A touchable meta-tyvar -> TcType -- The RHS -> TcS (PuResult () Reduction) --- Used for Nominal, Wanted equalities, with a touchble meta-tyvar on LHS +-- Used for Nominal, Wanted equalities, with a touchable meta-tyvar on LHS -- If checkTouchableTyVarEq tv ty = PuOK redn cts -- then we can unify -- tv := ty |> redn ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2730,6 +2730,8 @@ mapCheck f xs -- unzipRedns :: [Reduction] -> Reductions ----------------------------- +-- | Options describing how to deal with a type equality +-- in the pure unifier. See 'checkTyEqRhs' data TyEqFlags a = TEF { tef_foralls :: Bool -- Allow foralls , tef_lhs :: CanEqLHS -- LHS of the constraint @@ -2737,7 +2739,9 @@ data TyEqFlags a , tef_fam_app :: TyEqFamApp a , tef_occurs :: CheckTyEqProblem } -- Soluble or insoluble occurs check --- What to do for a type-family application +-- | What to do when encountering a type-family application while processing +-- a type equality in the pure unifier. +-- -- See Note [Family applications in canonical constraints] data TyEqFamApp a = TEFA_Fail -- Always fail @@ -2754,13 +2758,15 @@ data AreUnifying | NotUnifying -- Not attempting to unify data LevelCheck - = LC_None -- Level check not needed: we should never encounter a - -- tyvar at deeper level than the LHS + = LC_None -- Level check not needed: we should never encounter + -- a tyvar at deeper level than the LHS - | LC_Check -- Do a level check against this level; fail if it fails + | LC_Check -- Do a level check between the LHS tyvar and the occurrence tyvar + -- Fail if the level check fails - | LC_Promote -- Do a level check against this level; if it fails on a - -- unification variable, promote it + | LC_Promote -- Do a level check between the LHS tyvar and the occurrence tyvar + -- If the level check fails, and the occurrence is a unification + -- variable, promote it instance Outputable (TyEqFlags a) where ppr (TEF { .. }) = text "TEF" <> braces ( @@ -2773,7 +2779,7 @@ instance Outputable (TyEqFlags a) where instance Outputable (TyEqFamApp a) where ppr TEFA_Fail = text "TEFA_Fail" ppr TEFA_Recurse = text "TEFA_Fail" - ppr (TEFA_Break {}) = text "TEFA_Brefak" + ppr (TEFA_Break {}) = text "TEFA_Break" instance Outputable AreUnifying where ppr NotUnifying = text "NotUnifying" @@ -3076,8 +3082,12 @@ checkTyVar (TEF { tef_lhs = lhs, tef_unifying = unifying, tef_occurs = occ_prob -- Remember, the entire process started with a fully zonked type Nothing -> check_unif info lvl LC_Promote lhs_tv } + check_tv (Unifying info lvl prom) lhs_tv - = check_unif info lvl prom lhs_tv + = -- If prom=LC_Check or LC_None we don't fill any tyvars, + -- so no need for the isFilledMetaTyVar check + -- Remember, the entire process started with a fully zonked type + check_unif info lvl prom lhs_tv --------------------- -- We are in the Unifying branch of AreUnifing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/312b39757c5af257985a72d2f29ebed803bc8722...8d947c3c235899bdaa85aa54f34d7ede00bb9443 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/312b39757c5af257985a72d2f29ebed803bc8722...8d947c3c235899bdaa85aa54f34d7ede00bb9443 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 20:17:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 29 Mar 2023 16:17:08 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Handle records in the renamer Message-ID: <64249cc435086_3483dad28de14160229@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString/Env.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Load.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/76bb4c586084d7fdcf0e5ce52623abbfca527c55...d246049c81b922f9beddc629988c4e3eda8d4115 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/76bb4c586084d7fdcf0e5ce52623abbfca527c55...d246049c81b922f9beddc629988c4e3eda8d4115 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 20:18:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 29 Mar 2023 16:18:00 -0400 Subject: [Git][ghc/ghc][master] hadrian: Fix path to HpcParser.y Message-ID: <64249cf871b96_3483dad499118186074@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - 1 changed file: - hadrian/src/Rules/SourceDist.hs Changes: ===================================== hadrian/src/Rules/SourceDist.hs ===================================== @@ -184,7 +184,7 @@ prepareTree dest = do , (stage0InTree , compiler, "GHC/Parser.y", "GHC/Parser.hs") , (stage0InTree , compiler, "GHC/Parser/Lexer.x", "GHC/Parser/Lexer.hs") , (stage0InTree , compiler, "GHC/Parser/HaddockLex.x", "GHC/Parser/HaddockLex.hs") - , (stage0InTree , hpcBin, "HpcParser.y", "HpcParser.hs") + , (stage0InTree , hpcBin, "src/HpcParser.y", "src/HpcParser.hs") , (stage0InTree , genprimopcode, "Parser.y", "Parser.hs") , (stage0InTree , genprimopcode, "Lexer.x", "Lexer.hs") ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41a572f656c04770366c29ef5554184cf685482f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41a572f656c04770366c29ef5554184cf685482f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 20:49:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 29 Mar 2023 16:49:03 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: hadrian: Fix path to HpcParser.y Message-ID: <6424a43f31d14_3483dae101ea020706e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - 42b1ed87 by Bodigrim at 2023-03-29T16:48:32-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 1d54c242 by Bodigrim at 2023-03-29T16:48:33-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - bfbcb6f0 by Bodigrim at 2023-03-29T16:48:33-04:00 Bump submodules - - - - - 559718a9 by Bodigrim at 2023-03-29T16:48:33-04:00 Fix tests - - - - - 6dd7cb1a by doyougnu at 2023-03-29T16:48:46-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - 131cf1c0 by Sylvain Henry at 2023-03-29T16:48:59-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - 30 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - + compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Prelude/Basic.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Heap.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Literal.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Printer.hs - compiler/GHC/StgToJS/Profiling.hs - compiler/GHC/StgToJS/Regs.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Rts/Types.hs - compiler/GHC/StgToJS/Stack.hs - compiler/GHC/StgToJS/StaticPtr.hs - compiler/GHC/StgToJS/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff70afe5f485e0cb904cf54e40d114d45e19a1d9...131cf1c098864dcc2f138d7e6b308a3316df3b6d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff70afe5f485e0cb904cf54e40d114d45e19a1d9...131cf1c098864dcc2f138d7e6b308a3316df3b6d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 21:31:21 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 29 Mar 2023 17:31:21 -0400 Subject: [Git][ghc/ghc][wip/T23134] 50 commits: Fix BCO creation setting caps when -j > -N Message-ID: <6424ae2985ef4_3483daeca56bc217483@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23134 at Glasgow Haskell Compiler / GHC Commits: c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - e2fadbf6 by Krzysztof Gogolewski at 2023-03-29T23:30:42+02:00 WIP: Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Llvm/MetaData.hs - compiler/GHC/Llvm/Ppr.hs - compiler/GHC/Llvm/Syntax.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e8e00c85d8684cab84ffe8628f54105c0b2651c...e2fadbf6beff52951f339151ff8a30c710e867d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e8e00c85d8684cab84ffe8628f54105c0b2651c...e2fadbf6beff52951f339151ff8a30c710e867d0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 21:51:27 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Wed, 29 Mar 2023 17:51:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/recordupd-changelog Message-ID: <6424b2df343a8_3483daf2a9838221326@gitlab.mail> sheaf pushed new branch wip/recordupd-changelog at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/recordupd-changelog You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 21:55:23 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 29 Mar 2023 17:55:23 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Allow quantification over equalities at top level (only) Message-ID: <6424b3cbdca25_3483daf2a981022339@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: c0b32576 by Simon Peyton Jones at 2023-03-29T22:56:36+01:00 Allow quantification over equalities at top level (only) - - - - - 1 changed file: - compiler/GHC/Tc/Solver.hs Changes: ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1705,7 +1705,8 @@ decidePromotedTyVars :: InferMode -- Also return CoVars that appear free in the final quantified types -- we can't quantify over these, and we must make sure they are in scope decidePromotedTyVars infer_mode name_taus psigs candidates - = do { (no_quant, maybe_quant) <- pick infer_mode candidates + = do { tc_lvl <- TcM.getTcLevel + ; (no_quant, maybe_quant) <- pick infer_mode (not (isTopTcLevel tc_lvl)) candidates -- If possible, we quantify over partial-sig qtvs, so they are -- not mono. Need to zonk them because they are meta-tyvar TyVarTvs @@ -1717,7 +1718,6 @@ decidePromotedTyVars infer_mode name_taus psigs candidates ; taus <- mapM (TcM.zonkTcType . snd) name_taus - ; tc_lvl <- TcM.getTcLevel ; let psig_tys = mkTyVarTys psig_qtvs ++ psig_theta -- (b) The co_var_tvs are tvs mentioned in the types of covars or @@ -1806,29 +1806,31 @@ decidePromotedTyVars infer_mode name_taus psigs candidates ; return (maybe_quant, co_vars) } where - pick :: InferMode -> [PredType] -> TcM ([PredType], [PredType]) + pick :: InferMode -> Bool -> [PredType] -> TcM ([PredType], [PredType]) -- Split the candidates into ones we definitely -- won't quantify, and ones that we might - pick ApplyMR cand = return (cand, []) - pick NoRestrictions cand = return (partition is_eq cand) - pick EagerDefaulting cand = do { os <- xoptM LangExt.OverloadedStrings - ; return (partition (is_int_ct os) cand) } + pick ApplyMR _ cand = return (cand, []) + pick NoRestrictions nested cand = return (partition (is_eq nested) cand) + pick EagerDefaulting nested cand = do { os <- xoptM LangExt.OverloadedStrings + ; return (partition (is_int_ct nested os) cand) } + + -- These functions return True for a constraint we should /not/ quantify -- For EagerDefaulting, do not quantify over -- over any interactive class constraint - is_int_ct ovl_strings pred + is_int_ct nested ovl_strings pred = case classifyPredType pred of ClassPred cls _ -> isInteractiveClass ovl_strings cls - EqPred {} -> True - IrredPred {} -> True - ForAllPred {} -> True + EqPred {} -> nested + IrredPred {} -> nested + ForAllPred {} -> nested - is_eq pred + is_eq nested pred = case classifyPredType pred of ClassPred {} -> False - EqPred {} -> True - IrredPred {} -> True - ForAllPred {} -> True + EqPred {} -> nested + IrredPred {} -> nested + ForAllPred {} -> nested ------------------- defaultTyVarsAndSimplify :: TcLevel View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0b325769f19dda81cad82de768e9f8563ec8273 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0b325769f19dda81cad82de768e9f8563ec8273 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 21:57:53 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 29 Mar 2023 17:57:53 -0400 Subject: [Git][ghc/ghc][wip/T13660] 4 commits: base: Move implementation of GHC.Foreign to GHC.Internal Message-ID: <6424b4619367c_3483daf2a9810226190@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: e451ffd6 by Ben Gamari at 2023-03-29T17:52:09-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - d39c9e1e by Ben Gamari at 2023-03-29T17:57:33-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - 804d2470 by Ben Gamari at 2023-03-29T17:57:40-04:00 base: Clean up documentation - - - - - 9847f8eb by Ben Gamari at 2023-03-29T17:57:40-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 3 changed files: - libraries/base/GHC/Foreign.hs → libraries/base/GHC/Foreign/Internal.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal Changes: ===================================== libraries/base/GHC/Foreign.hs → libraries/base/GHC/Foreign/Internal.hs ===================================== @@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | --- Module : GHC.Foreign +-- Module : GHC.Foreign.Internal -- Copyright : (c) The University of Glasgow, 2008-2011 -- License : see libraries/base/LICENSE -- @@ -17,24 +17,23 @@ -- ----------------------------------------------------------------------------- -module GHC.Foreign ( +module GHC.Foreign.Internal ( -- * C strings with a configurable encoding CString, CStringLen, - -- conversion of C strings into Haskell strings - -- + -- * Conversion of C strings into Haskell strings peekCString, peekCStringLen, - -- conversion of Haskell strings into C strings - -- + -- * Conversion of Haskell strings into C strings newCString, newCStringLen, + newCStringLen0, - -- conversion of Haskell strings into C strings using temporary storage - -- + -- * Conversion of Haskell strings into C strings using temporary storage withCString, withCStringLen, + withCStringLen0, withCStringsLen, charIsRepresentable, @@ -111,6 +110,8 @@ newCString enc = liftM fst . newEncodedCString enc True -- | Marshal a Haskell string into a C string (ie, character array) with -- explicit length information. -- +-- Note that this does not NUL terminate the resulting string. +-- -- * new storage is allocated for the C string and must be -- explicitly freed using 'Foreign.Marshal.Alloc.free' or -- 'Foreign.Marshal.Alloc.finalizerFree'. @@ -133,6 +134,8 @@ withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp -- | Marshal a Haskell string into a C string (ie, character array) -- in temporary storage, with explicit length information. -- +-- Note that this does not NUL terminate the resulting string. +-- -- * the memory is freed when the subcomputation terminates (either -- normally or via an exception), so the pointer to the temporary -- storage must /not/ be used after this. @@ -140,6 +143,28 @@ withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a withCStringLen enc = withEncodedCString enc False +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- with explicit length information. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +-- @since 4.19.0.0 +newCStringLen0 :: TextEncoding -> String -> IO CStringLen +newCStringLen0 enc = newEncodedCString enc True + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +-- @since 4.19.0.0 +withCStringLen0 :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen0 enc = withEncodedCString enc True + -- | Marshal a list of Haskell strings into an array of NUL terminated C strings -- using temporary storage. -- ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -43,6 +43,7 @@ import System.IO.Error import GHC.Base import GHC.Num +import GHC.Ptr import GHC.Real import GHC.IO import GHC.IO.IOMode @@ -164,13 +165,22 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls fp = when ('\0' `elem` fp) (throwInternalNulError fp) #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,13 +188,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen0 enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen0 enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = + when (len' /= len) (throwInternalNulError fp) + -- N.B. If the string contains internal NUL codeunits then the strlen will + -- indicate a size smaller than that returned by withCStringLen. + where + len' = case str of Ptr ptr -> I# (cstringLength# ptr) #endif +throwInternalNulError :: FilePath -> IO a +throwInternalNulError fp = ioError err + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "FilePaths must not contain internal NUL code units." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + -- --------------------------------------------------------------------------- -- Terminal-related stuff ===================================== libraries/base/base.cabal ===================================== @@ -351,6 +351,7 @@ Library GHC.Event.IntVar GHC.Event.PSQ GHC.Event.Unique + GHC.Foreign.Internal -- GHC.IOPort -- TODO: hide again after debug GHC.Unicode.Internal.Bits GHC.Unicode.Internal.Char.DerivedCoreProperties View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdee87f9ab056846a8e467741cb836146063e474...9847f8eb9a406860bd532bc5efba1cb1a4b891f4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdee87f9ab056846a8e467741cb836146063e474...9847f8eb9a406860bd532bc5efba1cb1a4b891f4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Mar 29 23:39:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 29 Mar 2023 19:39:36 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Add {-# WARNING #-} to Data.List.{head,tail} Message-ID: <6424cc383d94f_3483da110a338424649e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 74877e80 by Bodigrim at 2023-03-29T19:39:23-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 95ca8d7c by Bodigrim at 2023-03-29T19:39:23-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - ff7763ab by Bodigrim at 2023-03-29T19:39:24-04:00 Bump submodules - - - - - ec67c494 by Bodigrim at 2023-03-29T19:39:24-04:00 Fix tests - - - - - 59cb0cf0 by doyougnu at 2023-03-29T19:39:26-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - 45c4b53c by Sylvain Henry at 2023-03-29T19:39:29-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - 84f45c51 by Ben Gamari at 2023-03-29T19:39:30-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 30 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - + compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Prelude/Basic.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Heap.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Literal.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Printer.hs - compiler/GHC/StgToJS/Profiling.hs - compiler/GHC/StgToJS/Regs.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Rts/Types.hs - compiler/GHC/StgToJS/Stack.hs - compiler/GHC/StgToJS/StaticPtr.hs - compiler/GHC/StgToJS/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/131cf1c098864dcc2f138d7e6b308a3316df3b6d...84f45c513edae810a15b2851a836bfcf267bb74c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/131cf1c098864dcc2f138d7e6b308a3316df3b6d...84f45c513edae810a15b2851a836bfcf267bb74c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 02:40:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 29 Mar 2023 22:40:02 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: js: split JMacro into JS eDSL and JS syntax Message-ID: <6424f682c31c4_3483da1408158827396@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 18092d52 by doyougnu at 2023-03-29T22:39:54-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - 745863bd by Sylvain Henry at 2023-03-29T22:39:57-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - e6d9160d by Ben Gamari at 2023-03-29T22:39:58-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 30 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - + compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Heap.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Literal.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Printer.hs - compiler/GHC/StgToJS/Profiling.hs - compiler/GHC/StgToJS/Regs.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Rts/Types.hs - compiler/GHC/StgToJS/Stack.hs - compiler/GHC/StgToJS/StaticPtr.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84f45c513edae810a15b2851a836bfcf267bb74c...e6d9160d1f70a27dffd0a4f323bb99fb5dd6f404 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84f45c513edae810a15b2851a836bfcf267bb74c...e6d9160d1f70a27dffd0a4f323bb99fb5dd6f404 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 05:40:23 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 30 Mar 2023 01:40:23 -0400 Subject: [Git][ghc/ghc][master] js: split JMacro into JS eDSL and JS syntax Message-ID: <642520c77a469_3483da171bab5429468e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - 30 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - + compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Heap.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Literal.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Printer.hs - compiler/GHC/StgToJS/Profiling.hs - compiler/GHC/StgToJS/Regs.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Rts/Types.hs - compiler/GHC/StgToJS/Stack.hs - compiler/GHC/StgToJS/StaticPtr.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b159e0e94f8d049198947965046b6a5edbd89c36 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b159e0e94f8d049198947965046b6a5edbd89c36 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 05:41:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 30 Mar 2023 01:41:05 -0400 Subject: [Git][ghc/ghc][master] ghc-heap: remove wrong Addr# coercion (#23181) Message-ID: <642520f1f78_3483da171bab68298064@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - 3 changed files: - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/tests/heap_all.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -112,15 +112,15 @@ instance Word# ~ a => HasHeapRep (a :: TYPE 'WordRep) where instance Int64# ~ a => HasHeapRep (a :: TYPE 'Int64Rep) where getClosureData x = return $ - Int64Closure { ptipe = PInt64, int64Val = I64# (unsafeCoerce# x) } + Int64Closure { ptipe = PInt64, int64Val = I64# x } instance Word64# ~ a => HasHeapRep (a :: TYPE 'Word64Rep) where getClosureData x = return $ - Word64Closure { ptipe = PWord64, word64Val = W64# (unsafeCoerce# x) } + Word64Closure { ptipe = PWord64, word64Val = W64# x } instance Addr# ~ a => HasHeapRep (a :: TYPE 'AddrRep) where getClosureData x = return $ - AddrClosure { ptipe = PAddr, addrVal = I# (unsafeCoerce# x) } + AddrClosure { ptipe = PAddr, addrVal = Ptr x } instance Float# ~ a => HasHeapRep (a :: TYPE 'FloatRep) where getClosureData x = return $ ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -329,7 +329,7 @@ data GenClosure b -- | Primitive Addr | AddrClosure { ptipe :: PrimType - , addrVal :: !Int } + , addrVal :: !(Ptr ()) } -- | Primitive Float | FloatClosure ===================================== libraries/ghc-heap/tests/heap_all.hs ===================================== @@ -12,6 +12,7 @@ import GHC.Int import GHC.IO import GHC.IORef import GHC.MVar +import GHC.Ptr import GHC.Stack import GHC.STRef import GHC.Weak @@ -176,7 +177,7 @@ exWord64Closure = Word64Closure exAddrClosure :: Closure exAddrClosure = AddrClosure - { ptipe = PAddr, addrVal = 42 } + { ptipe = PAddr, addrVal = nullPtr `plusPtr` 42 } exFloatClosure :: Closure exFloatClosure = FloatClosure @@ -316,19 +317,17 @@ main = do assertClosuresEq exWordClosure -- Primitive Int64 - -- FAILING: On 64-bit platforms, v is a regular Int - -- let (I64# v) = 42 - -- getClosureData v >>= - -- assertClosuresEq exInt64Closure + let (I64# v) = 42 + getClosureData v >>= + assertClosuresEq exInt64Closure -- Primitive Word64 - -- FAILING: On 64-bit platforms, v is a regular Word - -- let (W64# v) = 42 - -- getClosureData v >>= - -- assertClosuresEq exWord64Closure + let (W64# v) = 42 + getClosureData v >>= + assertClosuresEq exWord64Closure -- Primitive Addr - let v = unsafeCoerce# 42# :: Addr# + let (Ptr v) = nullPtr `plusPtr` 42 getClosureData v >>= assertClosuresEq exAddrClosure View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f4f1f14f8009c3c120b8b963ec130cbbc774ec02 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f4f1f14f8009c3c120b8b963ec130cbbc774ec02 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 05:41:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 30 Mar 2023 01:41:41 -0400 Subject: [Git][ghc/ghc][master] testsuite: Fix racing prints in T21465 Message-ID: <64252115c6f7c_3483da171bab68303314@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 3 changed files: - testsuite/tests/rts/T21465/T21465.hs - testsuite/tests/rts/T21465/T21465.stdout - testsuite/tests/rts/T21465/T21465_c.c Changes: ===================================== testsuite/tests/rts/T21465/T21465.hs ===================================== @@ -1,10 +1,12 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Main where +import System.IO + foreign import ccall "test_c" testC :: IO () helper :: IO () -helper = putStrLn "This is the helper function" +helper = putStrLn "This is the helper function" >> hFlush stdout foreign export ccall helper :: IO () ===================================== testsuite/tests/rts/T21465/T21465.stdout ===================================== @@ -1,5 +1,4 @@ This is the helper function -Done. 0: 01 01 1: 02 02 2: 03 03 @@ -16,3 +15,4 @@ Done. 13: 0e 0e 14: 0f 0f 15: 10 10 +Done. ===================================== testsuite/tests/rts/T21465/T21465_c.c ===================================== @@ -25,4 +25,5 @@ void test_c() { for (int i = 0; i < 16; i++) { printf("%2i: %02x %02x\n", i, blah[i], foo[i]); } + fflush(stdout); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5360490949533933dc8d76237ea87d920d7e311 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5360490949533933dc8d76237ea87d920d7e311 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 08:11:39 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Thu, 30 Mar 2023 04:11:39 -0400 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Fix tests Message-ID: <6425443ba5fb8_3483da19feb334334654@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 980faf2b by Sven Tennie at 2023-03-30T08:11:07+00:00 Fix tests - - - - - 6 changed files: - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/tests/TestUtils.hs - libraries/ghc-heap/tests/stack_big_ret.hs - libraries/ghc-heap/tests/stack_misc_closures.hs - libraries/ghc-heap/tests/stack_stm_frames.hs - libraries/ghc-heap/tests/stack_underflow.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -56,7 +56,9 @@ module GHC.Exts.Heap ( , getBoxedClosureData , allClosures , closureSize - +#if MIN_TOOL_VERSION_ghc(9,7,0) + , stackFrameSize +#endif -- * Boxes , Box(..) , asBox @@ -182,3 +184,24 @@ getBoxedClosureData (Box a) = getClosureData a -- @since 8.10.1 closureSize :: Box -> IO Int closureSize (Box x) = pure $ I# (closureSize# x) + +#if MIN_TOOL_VERSION_ghc(9,7,0) +-- TODO: Pattern match may move to function arguments +stackFrameSize :: StackFrame -> Int +stackFrameSize = + \c -> + case c of + UpdateFrame {} -> sizeStgUpdateFrame + CatchFrame {} -> sizeStgCatchFrame + CatchStmFrame {} -> sizeStgCatchSTMFrame + CatchRetryFrame {} -> sizeStgCatchRetryFrame + AtomicallyFrame {} -> sizeStgAtomicallyFrame + RetSmall {..} -> sizeStgClosure + length stack_payload + RetBig {..} -> sizeStgClosure + length stack_payload + RetFun {..} -> sizeStgRetFunFrame + length retFunPayload + -- The one additional word is a pointer to the StgBCO in the closure's payload + RetBCO {..} -> sizeStgClosure + 1 + length bcoArgs + -- The one additional word is a pointer to the next stack chunk + UnderflowFrame {} -> sizeStgClosure + 1 + _ -> error "Unexpected closure type" +#endif ===================================== libraries/ghc-heap/tests/TestUtils.hs ===================================== @@ -25,12 +25,12 @@ import GHC.Stack (HasCallStack) import GHC.Stack.CloneStack import Unsafe.Coerce (unsafeCoerce) -getDecodedStack :: IO (StackSnapshot, [Closure]) +getDecodedStack :: IO (StackSnapshot, [StackFrame]) getDecodedStack = do - s@(StackSnapshot s#) <- cloneMyStack - stackClosure <- getClosureData s# - unboxedCs <- mapM getBoxedClosureData (stack stackClosure) - pure (s, unboxedCs) + stack <- cloneMyStack + stackClosure <- decodeStack stack + + pure (stack, ssc_stack stackClosure) assertEqual :: (HasCallStack, Monad m, Show a, Eq a) => a -> a -> m () assertEqual a b @@ -40,8 +40,8 @@ assertEqual a b assertThat :: (HasCallStack, Monad m) => String -> (a -> Bool) -> a -> m () assertThat s f a = if f a then pure () else error s -assertStackInvariants :: (HasCallStack, MonadIO m) => StackSnapshot -> [Closure] -> m () -assertStackInvariants stack decodedStack = +assertStackInvariants :: (HasCallStack, MonadIO m) => [StackFrame] -> m () +assertStackInvariants decodedStack = assertThat "Last frame is stop frame" ( \case ===================================== libraries/ghc-heap/tests/stack_big_ret.hs ===================================== @@ -36,16 +36,16 @@ main = do bigFun (cloneStackReturnInt stackRef) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 mbStackSnapshot <- readIORef stackRef - let stackSnapshot@(StackSnapshot s#) = fromJust mbStackSnapshot - stackClosure <- getClosureData s# - stackFrames <- mapM getBoxedClosureData (stack stackClosure) + let stackSnapshot = fromJust mbStackSnapshot + stackClosure <- decodeStack stackSnapshot + let stackFrames = ssc_stack stackClosure - assertStackInvariants stackSnapshot stackFrames + assertStackInvariants stackFrames assertThat "Stack contains one big return frame" (== 1) (length $ filter isBigReturnFrame stackFrames) - cs <- (mapM unbox . payload . head) $ filter isBigReturnFrame stackFrames + let cs = (stack_payload . head) $ filter isBigReturnFrame stackFrames let xs = zip [1 ..] cs mapM_ (uncurry checkArg) xs @@ -62,6 +62,7 @@ checkArg w bp = assertEqual [w] (dataArgs c) pure () +isBigReturnFrame :: StackFrame -> Bool isBigReturnFrame (RetBig info _) = tipe info == RET_BIG isBigReturnFrame _ = False ===================================== libraries/ghc-heap/tests/stack_misc_closures.hs ===================================== @@ -25,6 +25,7 @@ import System.Info import System.Mem import TestUtils import Unsafe.Coerce (unsafeCoerce) +import GHC.Exts.Heap.Closures (StackFrame(info_tbl)) foreign import prim "any_update_framezh" any_update_frame# :: SetupFunction @@ -100,8 +101,8 @@ main = do test any_update_frame# $ \case UpdateFrame {..} -> do - assertEqual (tipe info) UPDATE_FRAME - assertEqual 1 =<< (getWordFromBlackhole =<< getBoxedClosureData updatee) + assertEqual (tipe info_tbl) UPDATE_FRAME + assertEqual 1 =<< getWordFromBlackhole updatee e -> error $ "Wrong closure type: " ++ show e traceM "Test 2" testSize any_update_frame# 2 @@ -109,9 +110,9 @@ main = do test any_catch_frame# $ \case CatchFrame {..} -> do - assertEqual (tipe info) CATCH_FRAME + assertEqual (tipe info_tbl) CATCH_FRAME assertEqual exceptions_blocked 1 - assertConstrClosure 1 =<< getBoxedClosureData handler + assertConstrClosure 1 handler e -> error $ "Wrong closure type: " ++ show e traceM "Test 4" testSize any_catch_frame# 3 @@ -119,9 +120,9 @@ main = do test any_catch_stm_frame# $ \case CatchStmFrame {..} -> do - assertEqual (tipe info) CATCH_STM_FRAME - assertConstrClosure 1 =<< getBoxedClosureData catchFrameCode - assertConstrClosure 2 =<< getBoxedClosureData handler + assertEqual (tipe info_tbl) CATCH_STM_FRAME + assertConstrClosure 1 catchFrameCode + assertConstrClosure 2 handler e -> error $ "Wrong closure type: " ++ show e traceM "Test 6" testSize any_catch_stm_frame# 3 @@ -129,10 +130,10 @@ main = do test any_catch_retry_frame# $ \case CatchRetryFrame {..} -> do - assertEqual (tipe info) CATCH_RETRY_FRAME + assertEqual (tipe info_tbl) CATCH_RETRY_FRAME assertEqual running_alt_code 1 - assertConstrClosure 2 =<< getBoxedClosureData first_code - assertConstrClosure 3 =<< getBoxedClosureData alt_code + assertConstrClosure 2 first_code + assertConstrClosure 3 alt_code e -> error $ "Wrong closure type: " ++ show e traceM "Test 8" testSize any_catch_retry_frame# 4 @@ -140,9 +141,9 @@ main = do test any_atomically_frame# $ \case AtomicallyFrame {..} -> do - assertEqual (tipe info) ATOMICALLY_FRAME - assertConstrClosure 1 =<< getBoxedClosureData atomicallyFrameCode - assertConstrClosure 2 =<< getBoxedClosureData result + assertEqual (tipe info_tbl) ATOMICALLY_FRAME + assertConstrClosure 1 atomicallyFrameCode + assertConstrClosure 2 result e -> error $ "Wrong closure type: " ++ show e traceM "Test 10" testSize any_atomically_frame# 3 @@ -150,10 +151,9 @@ main = do test any_ret_small_prim_frame# $ \case RetSmall {..} -> do - assertEqual (tipe info) RET_SMALL - pCs <- mapM getBoxedClosureData payload - assertEqual (length pCs) 1 - assertUnknownTypeWordSizedPrimitive 1 (head pCs) + assertEqual (tipe info_tbl) RET_SMALL + assertEqual (length stack_payload) 1 + assertUnknownTypeWordSizedPrimitive 1 (head stack_payload) e -> error $ "Wrong closure type: " ++ show e traceM "Test 12" testSize any_ret_small_prim_frame# 2 @@ -161,10 +161,9 @@ main = do test any_ret_small_closure_frame# $ \case RetSmall {..} -> do - assertEqual (tipe info) RET_SMALL - pCs <- mapM getBoxedClosureData payload - assertEqual (length pCs) 1 - assertConstrClosure 1 (head pCs) + assertEqual (tipe info_tbl) RET_SMALL + assertEqual (length stack_payload) 1 + assertConstrClosure 1 (head stack_payload) e -> error $ "Wrong closure type: " ++ show e traceM "Test 14" testSize any_ret_small_closure_frame# 2 @@ -172,10 +171,9 @@ main = do test any_ret_small_closures_frame# $ \case RetSmall {..} -> do - assertEqual (tipe info) RET_SMALL - pCs <- mapM getBoxedClosureData payload - assertEqual (length pCs) maxSmallBitmapBits - let wds = map getWordFromConstr01 pCs + assertEqual (tipe info_tbl) RET_SMALL + assertEqual (length stack_payload) maxSmallBitmapBits + let wds = map getWordFromConstr01 stack_payload assertEqual wds [1 .. maxSmallBitmapBits] e -> error $ "Wrong closure type: " ++ show e traceM "Test 16" @@ -184,10 +182,9 @@ main = do test any_ret_small_prims_frame# $ \case RetSmall {..} -> do - assertEqual (tipe info) RET_SMALL - pCs <- mapM getBoxedClosureData payload - assertEqual (length pCs) maxSmallBitmapBits - let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs + assertEqual (tipe info_tbl) RET_SMALL + assertEqual (length stack_payload) maxSmallBitmapBits + let wds = map getWordFromUnknownTypeWordSizedPrimitive stack_payload assertEqual wds [1 .. maxSmallBitmapBits] e -> error $ "Wrong closure type: " ++ show e traceM "Test 18" @@ -196,10 +193,9 @@ main = do test any_ret_big_prims_min_frame# $ \case RetBig {..} -> do - assertEqual (tipe info) RET_BIG - pCs <- mapM getBoxedClosureData payload - assertEqual (length pCs) minBigBitmapBits - let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs + assertEqual (tipe info_tbl) RET_BIG + assertEqual (length stack_payload) minBigBitmapBits + let wds = map getWordFromUnknownTypeWordSizedPrimitive stack_payload assertEqual wds [1 .. minBigBitmapBits] e -> error $ "Wrong closure type: " ++ show e traceM "Test 20" @@ -208,10 +204,9 @@ main = do test any_ret_big_closures_min_frame# $ \case RetBig {..} -> do - assertEqual (tipe info) RET_BIG - pCs <- mapM getBoxedClosureData payload - assertEqual (length pCs) minBigBitmapBits - let wds = map getWordFromConstr01 pCs + assertEqual (tipe info_tbl) RET_BIG + assertEqual (length stack_payload) minBigBitmapBits + let wds = map getWordFromConstr01 stack_payload assertEqual wds [1 .. minBigBitmapBits] e -> error $ "Wrong closure type: " ++ show e traceM "Test 22" @@ -220,11 +215,10 @@ main = do test any_ret_big_closures_two_words_frame# $ \case RetBig {..} -> do - assertEqual (tipe info) RET_BIG - pCs <- mapM getBoxedClosureData payload + assertEqual (tipe info_tbl) RET_BIG let closureCount = fromIntegral $ bitsInWord + 1 - assertEqual (length pCs) closureCount - let wds = map getWordFromConstr01 pCs + assertEqual (length stack_payload) closureCount + let wds = map getWordFromConstr01 stack_payload assertEqual wds [1 .. (fromIntegral closureCount)] e -> error $ "Wrong closure type: " ++ show e traceM "Test 24" @@ -233,24 +227,22 @@ main = do test any_ret_fun_arg_n_prim_frame# $ \case RetFun {..} -> do - assertEqual (tipe info) RET_FUN + assertEqual (tipe info_tbl) RET_FUN assertEqual retFunType ARG_N assertEqual retFunSize 1 - assertFun01Closure 1 =<< getBoxedClosureData retFunFun - pCs <- mapM getBoxedClosureData retFunPayload - assertEqual (length pCs) 1 - let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs + assertFun01Closure 1 retFunFun + assertEqual (length retFunPayload) 1 + let wds = map getWordFromUnknownTypeWordSizedPrimitive retFunPayload assertEqual wds [1] e -> error $ "Wrong closure type: " ++ show e traceM "Test 26" test any_ret_fun_arg_gen_frame# $ \case RetFun {..} -> do - assertEqual (tipe info) RET_FUN + assertEqual (tipe info_tbl) RET_FUN assertEqual retFunType ARG_GEN assertEqual retFunSize 9 - fc <- getBoxedClosureData retFunFun - case fc of + case retFunFun of FunClosure {..} -> do assertEqual (tipe info) FUN_STATIC assertEqual (null dataArgs) True @@ -258,9 +250,8 @@ main = do -- function `argGenFun` assertEqual (null ptrArgs) (os /= "darwin") e -> error $ "Wrong closure type: " ++ show e - pCs <- mapM getBoxedClosureData retFunPayload - assertEqual (length pCs) 9 - let wds = map getWordFromConstr01 pCs + assertEqual (length retFunPayload) 9 + let wds = map getWordFromConstr01 retFunPayload assertEqual wds [1 .. 9] e -> error $ "Wrong closure type: " ++ show e traceM "Test 27" @@ -269,19 +260,17 @@ main = do test any_ret_fun_arg_gen_big_frame# $ \case RetFun {..} -> do - assertEqual (tipe info) RET_FUN + assertEqual (tipe info_tbl) RET_FUN assertEqual retFunType ARG_GEN_BIG assertEqual retFunSize 59 - fc <- getBoxedClosureData retFunFun - case fc of + case retFunFun of FunClosure {..} -> do assertEqual (tipe info) FUN_STATIC assertEqual (null dataArgs) True assertEqual (null ptrArgs) True e -> error $ "Wrong closure type: " ++ show e - pCs <- mapM getBoxedClosureData retFunPayload - assertEqual (length pCs) 59 - let wds = map getWordFromConstr01 pCs + assertEqual (length retFunPayload) 59 + let wds = map getWordFromConstr01 retFunPayload assertEqual wds [1 .. 59] traceM "Test 29" testSize any_ret_fun_arg_gen_big_frame# (3 + 59) @@ -289,12 +278,10 @@ main = do test any_bco_frame# $ \case RetBCO {..} -> do - assertEqual (tipe info) RET_BCO - pCs <- mapM getBoxedClosureData bcoArgs - assertEqual (length pCs) 1 - let wds = map getWordFromConstr01 pCs + assertEqual (tipe info_tbl) RET_BCO + assertEqual (length bcoArgs) 1 + let wds = map getWordFromConstr01 bcoArgs assertEqual wds [3] - bco <- getBoxedClosureData bco case bco of BCOClosure {..} -> do assertEqual (tipe info) BCO @@ -316,58 +303,43 @@ main = do test any_underflow_frame# $ \case UnderflowFrame {..} -> do - assertEqual (tipe info) UNDERFLOW_FRAME - nextStack <- getBoxedClosureData nextChunk - case nextStack of - StackClosure {..} -> do - assertEqual (tipe info) STACK - assertEqual stack_size 27 - assertEqual stack_dirty 0 - assertEqual stack_marking 0 - nextStackClosures <- mapM getBoxedClosureData stack - assertEqual (length nextStackClosures) 2 - case head nextStackClosures of - RetSmall {..} -> - assertEqual (tipe info) RET_SMALL - e -> error $ "Wrong closure type: " ++ show e - case last nextStackClosures of - StopFrame {..} -> - assertEqual (tipe info) STOP_FRAME - e -> error $ "Wrong closure type: " ++ show e + assertEqual (tipe info_tbl) UNDERFLOW_FRAME + assertEqual (tipe (ssc_info nextChunk)) STACK + assertEqual (ssc_stack_size nextChunk) 27 + assertEqual (ssc_stack_dirty nextChunk) 0 + assertEqual (ssc_stack_marking nextChunk) 0 + assertEqual (length (ssc_stack nextChunk)) 2 + case head (ssc_stack nextChunk) of + RetSmall {..} -> + assertEqual (tipe info_tbl) RET_SMALL + e -> error $ "Wrong closure type: " ++ show e + case last (ssc_stack nextChunk) of + StopFrame {..} -> + assertEqual (tipe info_tbl) STOP_FRAME e -> error $ "Wrong closure type: " ++ show e e -> error $ "Wrong closure type: " ++ show e testSize any_underflow_frame# 2 type SetupFunction = State# RealWorld -> (# State# RealWorld, StackSnapshot# #) -test :: HasCallStack => SetupFunction -> (Closure -> IO ()) -> IO () +test :: HasCallStack => SetupFunction -> (StackFrame -> IO ()) -> IO () test setup assertion = do - sn@(StackSnapshot sn#) <- getStackSnapshot setup + stackSnapshot <- getStackSnapshot setup performGC traceM $ "entertainGC - " ++ entertainGC 100 -- Run garbage collection now, to prevent later surprises: It's hard to debug -- when the GC suddenly does it's work and there were bad closures or pointers. -- Better fail early, here. performGC - stackClosure <- getClosureData sn# + stackClosure <- decodeStack stackSnapshot performGC - let boxedFrames = stack stackClosure - stack <- mapM getBoxedClosureData boxedFrames + let stack = ssc_stack stackClosure performGC - assert sn stack - -- The result of HasHeapRep should be similar (wrapped in the closure for - -- StgStack itself.) - let (StackSnapshot sn#) = sn - stack' <- getClosureData sn# - case stack' of - StackClosure {..} -> do - !cs <- mapM getBoxedClosureData stack - assert sn cs - _ -> error $ "Unexpected closure type : " ++ show stack' + assert stack where - assert :: StackSnapshot -> [Closure] -> IO () - assert sn stack = do - assertStackInvariants sn stack + assert :: [StackFrame] -> IO () + assert stack = do + assertStackInvariants stack assertEqual (length stack) 2 assertion $ head stack @@ -377,9 +349,9 @@ entertainGC x = show x ++ entertainGC (x - 1) testSize :: HasCallStack => SetupFunction -> Int -> IO () testSize setup expectedSize = do - (StackSnapshot sn#) <- getStackSnapshot setup - stackClosure <- getClosureData sn# - assertEqual expectedSize =<< (closureSize . head . stack) stackClosure + stackSnapshot <- getStackSnapshot setup + stackClosure <- decodeStack stackSnapshot + assertEqual expectedSize $ (stackFrameSize . head . ssc_stack) stackClosure -- | Get a `StackSnapshot` from test setup -- ===================================== libraries/ghc-heap/tests/stack_stm_frames.hs ===================================== @@ -19,7 +19,7 @@ main = do atomically $ catchSTM @SomeException (unsafeIOToSTM getDecodedStack) throwSTM - assertStackInvariants stackSnapshot decodedStack + assertStackInvariants decodedStack assertThat "Stack contains one catch stm frame" (== 1) @@ -29,10 +29,10 @@ main = do (== 1) (length $ filter isAtomicallyFrame decodedStack) -isCatchStmFrame :: Closure -> Bool -isCatchStmFrame (CatchStmFrame {..}) = tipe info == CATCH_STM_FRAME +isCatchStmFrame :: StackFrame -> Bool +isCatchStmFrame (CatchStmFrame {..}) = tipe info_tbl == CATCH_STM_FRAME isCatchStmFrame _ = False -isAtomicallyFrame :: Closure -> Bool -isAtomicallyFrame (AtomicallyFrame {..}) = tipe info == ATOMICALLY_FRAME +isAtomicallyFrame :: StackFrame -> Bool +isAtomicallyFrame (AtomicallyFrame {..}) = tipe info_tbl == ATOMICALLY_FRAME isAtomicallyFrame _ = False ===================================== libraries/ghc-heap/tests/stack_underflow.hs ===================================== @@ -22,7 +22,7 @@ loop n = print "x" >> loop (n - 1) >> print "x" getStack :: HasCallStack => IO () getStack = do (s, decodedStack) <- getDecodedStack - assertStackInvariants s decodedStack + assertStackInvariants decodedStack assertThat "Stack contains underflow frames" (== True) @@ -30,17 +30,20 @@ getStack = do assertStackChunksAreDecodable decodedStack return () -isUnderflowFrame (UnderflowFrame {..}) = tipe info == UNDERFLOW_FRAME +isUnderflowFrame :: StackFrame -> Bool +isUnderflowFrame (UnderflowFrame {..}) = tipe info_tbl == UNDERFLOW_FRAME isUnderflowFrame _ = False -assertStackChunksAreDecodable :: HasCallStack => [Closure] -> IO () +assertStackChunksAreDecodable :: HasCallStack => [StackFrame] -> IO () assertStackChunksAreDecodable s = do let underflowFrames = filter isUnderflowFrame s - stackClosures <- mapM (getBoxedClosureData . nextChunk) underflowFrames - let stackBoxes = map stack stackClosures - framesOfChunks <- mapM (mapM getBoxedClosureData) stackBoxes + assertThat + "Expect some underflow frames" + (>= 2) + (length underflowFrames) + let stackFrames = map (ssc_stack . nextChunk) underflowFrames assertThat "No empty stack chunks" (== True) - ( not (any null framesOfChunks) + ( not (any null stackFrames) ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/980faf2bb5f3552f8040aefdf2404ec8c8d36ee4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/980faf2bb5f3552f8040aefdf2404ec8c8d36ee4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 08:59:44 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 30 Mar 2023 04:59:44 -0400 Subject: [Git][ghc/ghc][master] Revert "ghc-heap: remove wrong Addr# coercion (#23181)" Message-ID: <64254f80797ac_3483da1ae57d78378998@gitlab.mail> Matthew Pickering pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 3 changed files: - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/tests/heap_all.hs Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -112,15 +112,15 @@ instance Word# ~ a => HasHeapRep (a :: TYPE 'WordRep) where instance Int64# ~ a => HasHeapRep (a :: TYPE 'Int64Rep) where getClosureData x = return $ - Int64Closure { ptipe = PInt64, int64Val = I64# x } + Int64Closure { ptipe = PInt64, int64Val = I64# (unsafeCoerce# x) } instance Word64# ~ a => HasHeapRep (a :: TYPE 'Word64Rep) where getClosureData x = return $ - Word64Closure { ptipe = PWord64, word64Val = W64# x } + Word64Closure { ptipe = PWord64, word64Val = W64# (unsafeCoerce# x) } instance Addr# ~ a => HasHeapRep (a :: TYPE 'AddrRep) where getClosureData x = return $ - AddrClosure { ptipe = PAddr, addrVal = Ptr x } + AddrClosure { ptipe = PAddr, addrVal = I# (unsafeCoerce# x) } instance Float# ~ a => HasHeapRep (a :: TYPE 'FloatRep) where getClosureData x = return $ ===================================== libraries/ghc-heap/GHC/Exts/Heap/Closures.hs ===================================== @@ -329,7 +329,7 @@ data GenClosure b -- | Primitive Addr | AddrClosure { ptipe :: PrimType - , addrVal :: !(Ptr ()) } + , addrVal :: !Int } -- | Primitive Float | FloatClosure ===================================== libraries/ghc-heap/tests/heap_all.hs ===================================== @@ -12,7 +12,6 @@ import GHC.Int import GHC.IO import GHC.IORef import GHC.MVar -import GHC.Ptr import GHC.Stack import GHC.STRef import GHC.Weak @@ -177,7 +176,7 @@ exWord64Closure = Word64Closure exAddrClosure :: Closure exAddrClosure = AddrClosure - { ptipe = PAddr, addrVal = nullPtr `plusPtr` 42 } + { ptipe = PAddr, addrVal = 42 } exFloatClosure :: Closure exFloatClosure = FloatClosure @@ -317,17 +316,19 @@ main = do assertClosuresEq exWordClosure -- Primitive Int64 - let (I64# v) = 42 - getClosureData v >>= - assertClosuresEq exInt64Closure + -- FAILING: On 64-bit platforms, v is a regular Int + -- let (I64# v) = 42 + -- getClosureData v >>= + -- assertClosuresEq exInt64Closure -- Primitive Word64 - let (W64# v) = 42 - getClosureData v >>= - assertClosuresEq exWord64Closure + -- FAILING: On 64-bit platforms, v is a regular Word + -- let (W64# v) = 42 + -- getClosureData v >>= + -- assertClosuresEq exWord64Closure -- Primitive Addr - let (Ptr v) = nullPtr `plusPtr` 42 + let v = unsafeCoerce# 42# :: Addr# getClosureData v >>= assertClosuresEq exAddrClosure View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98b5cf67f8428b0daefcbf5df121df0b8a126654 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98b5cf67f8428b0daefcbf5df121df0b8a126654 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 09:02:55 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 30 Mar 2023 05:02:55 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/23181-2 Message-ID: <6425503f802d7_3483da1aed403038457d@gitlab.mail> Matthew Pickering pushed new branch wip/23181-2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/23181-2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 10:32:54 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Thu, 30 Mar 2023 06:32:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/rename-gadt Message-ID: <642565564fc54_3483da1cc3c190419877@gitlab.mail> sheaf pushed new branch wip/rename-gadt at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/rename-gadt You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 10:40:21 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 30 Mar 2023 06:40:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/bootstrap-9_6 Message-ID: <6425671545c26_3483da1ce1822042483f@gitlab.mail> Matthew Pickering pushed new branch wip/bootstrap-9_6 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/bootstrap-9_6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 10:45:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 30 Mar 2023 06:45:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: js: split JMacro into JS eDSL and JS syntax Message-ID: <6425684634fc4_3483da1d172f884301db@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 96587afc by Bodigrim at 2023-03-30T06:45:20-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 813f8e49 by Bodigrim at 2023-03-30T06:45:20-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - b2974ee3 by Bodigrim at 2023-03-30T06:45:20-04:00 Bump submodules - - - - - ab35504d by Bodigrim at 2023-03-30T06:45:20-04:00 Fix tests - - - - - bca7b4e1 by sheaf at 2023-03-30T06:45:20-04:00 Proxies for head and tail: review suggestions - - - - - 0b52db87 by sheaf at 2023-03-30T06:45:22-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 30 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Transform.hs - + compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Prelude/Basic.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Heap.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Literal.hs - compiler/GHC/StgToJS/Monad.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Printer.hs - compiler/GHC/StgToJS/Profiling.hs - compiler/GHC/StgToJS/Regs.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Rts/Types.hs - compiler/GHC/StgToJS/Stack.hs - compiler/GHC/StgToJS/StaticPtr.hs - compiler/GHC/StgToJS/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6d9160d1f70a27dffd0a4f323bb99fb5dd6f404...0b52db87bf0d813f5823f8010a8534c16edf139c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6d9160d1f70a27dffd0a4f323bb99fb5dd6f404...0b52db87bf0d813f5823f8010a8534c16edf139c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 11:24:33 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 30 Mar 2023 07:24:33 -0400 Subject: [Git][ghc/ghc][wip/bootstrap-9_6] ci: Add job to test 9.6 bootstrapping Message-ID: <64257171d2f27_3483da1db793b0452445@gitlab.mail> Matthew Pickering pushed to branch wip/bootstrap-9_6 at Glasgow Haskell Compiler / GHC Commits: 814ae3b5 by Matthew Pickering at 2023-03-30T11:42:22+01:00 ci: Add job to test 9.6 bootstrapping - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 572353e0644044fe3a5465bba4342a9a0b0eb60e + DOCKER_REV: ab73b45173cdcbdb617ecae93bd3a609555ef38d # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -86,6 +86,8 @@ workflow: DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_2:$DOCKER_REV" - GHC_VERSION: 9.4.3 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" + - GHC_VERSION: 9.6.1 + DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_6:$DOCKER_REV" # Allow linters to fail on draft MRs. # This must be explicitly transcluded in lint jobs which View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/814ae3b56f39b9385b0cd2392bd4bf61ed7dbd8c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/814ae3b56f39b9385b0cd2392bd4bf61ed7dbd8c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 11:56:20 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Thu, 30 Mar 2023 07:56:20 -0400 Subject: [Git][ghc/ghc][wip/T22696] 9 commits: Handle records in the renamer Message-ID: <642578e4eddf8_3483da1e3981044547c5@gitlab.mail> Ryan Scott pushed to branch wip/T22696 at Glasgow Haskell Compiler / GHC Commits: 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - e2b7c4b0 by Ryan Scott at 2023-03-30T07:52:59-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString/Env.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Load.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ba0aed804d28a19eb10359b8c049b9deadfeb56...e2b7c4b092eb55bfc2443bf5388ead312c39e5f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ba0aed804d28a19eb10359b8c049b9deadfeb56...e2b7c4b092eb55bfc2443bf5388ead312c39e5f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 13:01:03 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 30 Mar 2023 09:01:03 -0400 Subject: [Git][ghc/ghc][wip/bootstrap-9_6] ci: Add job to test 9.6 bootstrapping Message-ID: <6425880fafe96_3483da1f67b4744655e1@gitlab.mail> Matthew Pickering pushed to branch wip/bootstrap-9_6 at Glasgow Haskell Compiler / GHC Commits: e0cf084e by Matthew Pickering at 2023-03-30T14:00:56+01:00 ci: Add job to test 9.6 bootstrapping - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 572353e0644044fe3a5465bba4342a9a0b0eb60e + DOCKER_REV: 7a2f9560997025d37adefe7148e2a19808a5c593 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -86,6 +86,8 @@ workflow: DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_2:$DOCKER_REV" - GHC_VERSION: 9.4.3 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" + - GHC_VERSION: 9.6.1 + DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_6:$DOCKER_REV" # Allow linters to fail on draft MRs. # This must be explicitly transcluded in lint jobs which View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0cf084ee3521ad026eba0e3fa987558467e5072 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0cf084ee3521ad026eba0e3fa987558467e5072 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 13:28:40 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 30 Mar 2023 09:28:40 -0400 Subject: [Git][ghc/ghc][wip/T22152] 197 commits: Handle top-level Addr# literals in the bytecode compiler Message-ID: <64258e88b62e1_3483da1fd422f8489545@gitlab.mail> Sylvain Henry pushed to branch wip/T22152 at Glasgow Haskell Compiler / GHC Commits: 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - b2830c44 by Sylvain Henry at 2023-03-30T15:33:30+02:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4c96a5e1 by Sylvain Henry at 2023-03-30T15:33:30+02:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 29ae8fdd by Sylvain Henry at 2023-03-30T15:33:30+02:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 17822d93 by Sylvain Henry at 2023-03-30T15:33:30+02:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/test-metrics.sh - .gitmodules - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/ConLike.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f7f43ffdd97a7c52b8781476ce66f73669c44f0...17822d93cd4f5c0cde6453779a8be4267a9cc5a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f7f43ffdd97a7c52b8781476ce66f73669c44f0...17822d93cd4f5c0cde6453779a8be4267a9cc5a2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 13:45:49 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 30 Mar 2023 09:45:49 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Add {-# WARNING #-} to Data.List.{head,tail} Message-ID: <6425928d6ef27_3483da205536e04926f6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 604a2373 by Bodigrim at 2023-03-30T09:45:44-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 2d2c8ff0 by Bodigrim at 2023-03-30T09:45:44-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 45c6cce1 by Bodigrim at 2023-03-30T09:45:44-04:00 Bump submodules - - - - - 02a61e5a by Bodigrim at 2023-03-30T09:45:44-04:00 Fix tests - - - - - 58a7c957 by sheaf at 2023-03-30T09:45:44-04:00 Proxies for head and tail: review suggestions - - - - - f74e1f29 by sheaf at 2023-03-30T09:45:45-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 290fd552 by sheaf at 2023-03-30T09:45:46-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 30 changed files: - compiler/GHC/Prelude/Basic.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/ThToHs.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - hadrian/src/Settings/Warnings.hs - libraries/base/Control/Monad/Fix.hs - libraries/base/Data/List/NonEmpty.hs - libraries/base/GHC/List.hs - libraries/base/changelog.md - libraries/hpc - libraries/xhtml - testsuite/tests/codeGen/should_compile/T3286.hs - testsuite/tests/deSugar/should_compile/ds025.hs - testsuite/tests/ghc-api/T10052/T10052.hs - testsuite/tests/ghci.debugger/scripts/T18045.hs - testsuite/tests/ghci.debugger/scripts/T18045.script - testsuite/tests/ghci.debugger/scripts/T18045.stdout - testsuite/tests/ghci.debugger/scripts/break009.script - testsuite/tests/ghci.debugger/scripts/break010.script - testsuite/tests/ghci.debugger/scripts/print001.script - testsuite/tests/ghci.debugger/scripts/print004.script - testsuite/tests/ghci.debugger/scripts/print028.script - testsuite/tests/ghci/caf_crash/D.hs - testsuite/tests/ghci/scripts/T10501.script - testsuite/tests/ghci/scripts/T16804.script - testsuite/tests/impredicative/PList1.hs - testsuite/tests/impredicative/PList2.hs - testsuite/tests/impredicative/boxy.hs - testsuite/tests/impredicative/icfp20-ok.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b52db87bf0d813f5823f8010a8534c16edf139c...290fd55237668fb58a005f56ce08cf655836b8af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b52db87bf0d813f5823f8010a8534c16edf139c...290fd55237668fb58a005f56ce08cf655836b8af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 13:46:40 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 30 Mar 2023 09:46:40 -0400 Subject: [Git][ghc/ghc][wip/T23134] Fix unification with oversaturated type families Message-ID: <642592c05bb17_3483da205536e0500247@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23134 at Glasgow Haskell Compiler / GHC Commits: d0c0aa58 by Krzysztof Gogolewski at 2023-03-30T15:45:31+02:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - 4 changed files: - compiler/GHC/Core/Unify.hs - + testsuite/tests/simplCore/should_run/T23134.hs - + testsuite/tests/simplCore/should_run/T23134.stdout - testsuite/tests/simplCore/should_run/all.T Changes: ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1,6 +1,6 @@ -- (c) The University of Glasgow 2006 -{-# LANGUAGE ScopedTypeVariables, PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables, PatternSynonyms, MultiWayIf #-} {-# LANGUAGE DeriveFunctor #-} @@ -47,6 +47,7 @@ import GHC.Types.Unique import GHC.Types.Unique.FM import GHC.Types.Unique.Set import GHC.Exts( oneShot ) +import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Data.FastString @@ -994,6 +995,55 @@ These two TyConApps have the same TyCon at the front but they (legitimately) have different numbers of arguments. They are surelyApart, so we can report that without looking any further (see #15704). + +Note [Unifying type applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Unifying type applications is quite subtle, as we found +in #23134 and #22647, when type families are involved. + +Suppose + type family F a :: Type -> Type + type family G k :: k = r | r -> k + +and consider these examples: + +* F a ~ F b + This depends on the injectivity of the family F. + If F is injective, we can reduce this to a ~ b. + If not, we return MaybeApart. + +* G Type ~ G (Type -> Type) Int + Even though G is injective and the arguments to G are different, + we cannot deduce apartness because the RHS is oversaturated. + For example, G might be defined as + G Type = Maybe Int + G (Type -> Type) = Maybe + +* F Int Bool ~ F Int Char + F Int Bool ~ Maybe a + F Int Bool ~ a b + F Int Bool ~ Char -> Bool + An oversaturated type family can match an application, + whether it's a TyConApp, AppTy or FunTy. Decompose. + +* F Int ~ a b + We cannot decompose a saturated, or under-saturated + type family application. We return MaybeApart. + +To handle all those conditions, unify_ty goes through +the following checks in sequence, where F is a type family +of arity n: + +* F x_1 ... x_n ~ F y_1 .. y_n + Here we can unify arguments in which F is injective. +* F x_1 ... x_n ~ anything, anything ~ F x_1 ... x_n + A non-oversaturated type family can match anything - we return MaybeApart. +* F x_1 ... x_m ~ a b, a b ~ F x_1 ... x_m where m > n + An oversaturated type family can be decomposed. +* F x_1 ... x_m ~ anything, anything ~ F x_1 ... x_m, where m > n + If we couldn't decompose in the previous step, we return SurelyApart. + +Afterwards, the rest of the code doesn't have to worry about type families. -} -------------- unify_ty: the main workhorse ----------- @@ -1035,31 +1085,64 @@ unify_ty env ty1 (TyVarTy tv2) kco = uVar (umSwapRn env) tv2 ty1 (mkSymCo kco) unify_ty env ty1 ty2 _kco - | Just (tc1, tys1) <- mb_tc_app1 + + -- Handle non-oversaturated type families first + -- See Note [Unifying type applications] + -- + -- If we have T x1 ... xn ~ T y1 ... yn, use injectivity information of T + -- Note that both sides must not be oversaturated + | isSatTyFamApp mb_tc_app1 + , isSatTyFamApp mb_tc_app2 + , Just (tc1, tys1) <- mb_tc_app1 , Just (tc2, tys2) <- mb_tc_app2 , tc1 == tc2 - = if isInjectiveTyCon tc1 Nominal - then unify_tys env tys1 tys2 - else do { let inj | isTypeFamilyTyCon tc1 - = case tyConInjectivityInfo tc1 of - NotInjective -> repeat False - Injective bs -> bs - | otherwise - = repeat False - - (inj_tys1, noninj_tys1) = partitionByList inj tys1 - (inj_tys2, noninj_tys2) = partitionByList inj tys2 - - ; unify_tys env inj_tys1 inj_tys2 - ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification] - don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 } - - | isTyFamApp mb_tc_app1 -- A (not-over-saturated) type-family application + = do { let inj = case tyConInjectivityInfo tc1 of + NotInjective -> repeat False + Injective bs -> bs + + (inj_tys1, noninj_tys1) = partitionByList inj tys1 + (inj_tys2, noninj_tys2) = partitionByList inj tys2 + + ; unify_tys env inj_tys1 inj_tys2 + ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification] + don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 } + + | isSatTyFamApp mb_tc_app1 -- A (not-over-saturated) type-family application = maybeApart MARTypeFamily -- behaves like a type variable; might match - | isTyFamApp mb_tc_app2 -- A (not-over-saturated) type-family application - , um_unif env -- behaves like a type variable; might unify - = maybeApart MARTypeFamily + | isSatTyFamApp mb_tc_app2 -- A (not-over-saturated) type-family application + -- behaves like a type variable; might unify + = if um_unif env then maybeApart MARTypeFamily else surelyApart + + -- Handle oversaturated type families. + -- + -- They can match an application (TyConApp/FunTy/AppTy), this is handled + -- the same way as in the AppTy case below. + -- + -- If there is no application, an oversaturated type family can only + -- match a type variable or a saturated type family, + -- both of which we handled earlier. So we can say surelyApart. + | Just (tc1, _) <- mb_tc_app1 + , isTypeFamilyTyCon tc1 + = if | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 + , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 + -> unify_ty_app env ty1a [ty1b] ty2a [ty2b] + | otherwise -> surelyApart + + | Just (tc2, _) <- mb_tc_app2 + , isTypeFamilyTyCon tc2 + = if | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 + , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 + -> unify_ty_app env ty1a [ty1b] ty2a [ty2b] + | otherwise -> surelyApart + + -- At this point, neither tc1 nor tc2 can be a type family. + | Just (tc1, tys1) <- mb_tc_app1 + , Just (tc2, tys2) <- mb_tc_app2 + , tc1 == tc2 + = do { massertPpr (isInjectiveTyCon tc1 Nominal) (ppr tc1) + ; unify_tys env tys1 tys2 + } -- TYPE and CONSTRAINT are not Apart -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim @@ -1160,15 +1243,15 @@ unify_tys env orig_xs orig_ys -- Possibly different saturations of a polykinded tycon -- See Note [Polykinded tycon applications] -isTyFamApp :: Maybe (TyCon, [Type]) -> Bool +isSatTyFamApp :: Maybe (TyCon, [Type]) -> Bool -- True if we have a saturated or under-saturated type family application -- If it is /over/ saturated then we return False. E.g. -- unify_ty (F a b) (c d) where F has arity 1 -- we definitely want to decompose that type application! (#22647) -isTyFamApp (Just (tc, tys)) - = not (isGenerativeTyCon tc Nominal) -- Type family-ish +isSatTyFamApp (Just (tc, tys)) + = isTypeFamilyTyCon tc && not (tys `lengthExceeds` tyConArity tc) -- Not over-saturated -isTyFamApp Nothing +isSatTyFamApp Nothing = False --------------------------------- ===================================== testsuite/tests/simplCore/should_run/T23134.hs ===================================== @@ -0,0 +1,37 @@ +{-# LANGUAGE GHC2021, DataKinds, TypeFamilies #-} +module Main where + +import Data.Maybe +import Data.Kind + +main :: IO () +main = putStrLn str + +str :: String +str = case runInstrImpl @(TOption TUnit) mm MAP of + C VOption -> "good" + C Unused -> "bad" + +runInstrImpl :: forall inp out. Value (MapOpRes inp TUnit) -> Instr inp out -> Rec out +runInstrImpl m MAP = C m + +type MapOpRes :: T -> T -> T +type family MapOpRes c :: T -> T +type instance MapOpRes ('TOption x) = 'TOption + +mm :: Value (TOption TUnit) +mm = VOption +{-# NOINLINE mm #-} + +type Value :: T -> Type +data Value t where + VOption :: Value ('TOption t) + Unused :: Value t + +data T = TOption T | TUnit + +data Instr (inp :: T) (out :: T) where + MAP :: Instr c (TOption (MapOpRes c TUnit)) + +data Rec :: T -> Type where + C :: Value r -> Rec (TOption r) ===================================== testsuite/tests/simplCore/should_run/T23134.stdout ===================================== @@ -0,0 +1 @@ +good ===================================== testsuite/tests/simplCore/should_run/all.T ===================================== @@ -109,4 +109,5 @@ 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']) +test('T23134', normal, compile_and_run, ['-O0 -fcatch-nonexhaustive-cases']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d0c0aa58720c6b313499e4e39e2219e98335eb30 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d0c0aa58720c6b313499e4e39e2219e98335eb30 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 14:48:31 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 30 Mar 2023 10:48:31 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/bump-ci-images-2 Message-ID: <6425a13f1061e_3483da219796c451713c@gitlab.mail> Matthew Pickering pushed new branch wip/bump-ci-images-2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/bump-ci-images-2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 16:21:31 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 30 Mar 2023 12:21:31 -0400 Subject: [Git][ghc/ghc][wip/unsafe-coerce-doc] 189 commits: Improve GHC.Tc.Gen.App.tcInstFun Message-ID: <6425b70b93397_3483da23679a6c5506eb@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/unsafe-coerce-doc at Glasgow Haskell Compiler / GHC Commits: 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 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. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-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. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - b727a4ee by Krzysztof Gogolewski at 2023-03-30T18:14:13+02:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/test-metrics.sh - .gitmodules - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f62d7bee8c8bda34bf2540a081caaee2b03ef95...b727a4ee8b47c1fe6cee3689ddf16246b9a077ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f62d7bee8c8bda34bf2540a081caaee2b03ef95...b727a4ee8b47c1fe6cee3689ddf16246b9a077ea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 16:21:52 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 30 Mar 2023 12:21:52 -0400 Subject: [Git][ghc/ghc][wip/unsafe-coerce-doc] Fixes around unsafeCoerce# Message-ID: <6425b7201b3ee_3483da23679a6c5508f5@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/unsafe-coerce-doc at Glasgow Haskell Compiler / GHC Commits: b6dc0794 by Krzysztof Gogolewski at 2023-03-30T18:21:40+02:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 5 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Tc/Module.hs - libraries/base/Unsafe/Coerce.hs - testsuite/tests/ghci/should_run/T16096.stdout - testsuite/tests/ghci/should_run/T21052.stdout Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3845,50 +3845,6 @@ pseudoop "seq" -- This fixity is only the one picked up by Haddock. If you -- change this, do update 'ghcPrimIface' in 'GHC.Iface.Load'. -pseudoop "unsafeCoerce#" - o -> p - { The function 'unsafeCoerce#' allows you to side-step the typechecker entirely. That - is, it allows you to coerce any type into any other type. If you use this function, - you had better get it right, otherwise segmentation faults await. It is generally - used when you want to write a program that you know is well-typed, but where Haskell's - type system is not expressive enough to prove that it is well typed. - - The following uses of 'unsafeCoerce#' are supposed to work (i.e. not lead to - spurious compile-time or run-time crashes): - - * Casting any lifted type to 'Any' - - * Casting 'Any' back to the real type - - * Casting an unboxed type to another unboxed type of the same size. - (Casting between floating-point and integral types does not work. - See the "GHC.Float" module for functions to do work.) - - * Casting between two types that have the same runtime representation. One case is when - the two types differ only in "phantom" type parameters, for example - @'Ptr' 'Int'@ to @'Ptr' 'Float'@, or @['Int']@ to @['Float']@ when the list is - known to be empty. Also, a @newtype@ of a type @T@ has the same representation - at runtime as @T at . - - Other uses of 'unsafeCoerce#' are undefined. In particular, you should not use - 'unsafeCoerce#' to cast a T to an algebraic data type D, unless T is also - an algebraic data type. For example, do not cast @'Int'->'Int'@ to 'Bool', even if - you later cast that 'Bool' back to @'Int'->'Int'@ before applying it. The reasons - have to do with GHC's internal representation details (for the cognoscenti, data values - can be entered but function closures cannot). If you want a safe type to cast things - to, use 'Any', which is not an algebraic data type. - - } - with can_fail = True - --- NB. It is tempting to think that casting a value to a type that it doesn't have is safe --- as long as you don't "do anything" with the value in its cast form, such as seq on it. This --- isn't the case: the compiler can insert seqs itself, and if these happen at the wrong type, --- Bad Things Might Happen. See bug #1616: in this case we cast a function of type (a,b) -> (a,b) --- to () -> () and back again. The strictness analyser saw that the function was strict, but --- the wrapper had type () -> (), and hence the wrapper de-constructed the (), the worker re-constructed --- a new (), with the result that the code ended up with "case () of (a,b) -> ...". - primop TraceEventOp "traceEvent#" GenPrimOp Addr# -> State# s -> State# s { Emits an event via the RTS tracing framework. The contents ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -103,7 +103,7 @@ import GHC.Iface.Env ( externaliseName ) import GHC.Iface.Make ( coAxiomToIfaceDecl ) import GHC.Iface.Load -import GHC.Builtin.Types ( unitTy, mkListTy ) +import GHC.Builtin.Types ( mkListTy, anyTypeOfKind ) import GHC.Builtin.Names import GHC.Builtin.Utils @@ -2172,8 +2172,8 @@ We don't bother with the tcl_th_bndrs environment either. -- | The returned [Id] is the list of new Ids bound by this statement. It can -- be used to extend the InteractiveContext via extendInteractiveContext. -- --- The returned TypecheckedHsExpr is of type IO [ () ], a list of the bound --- values, coerced to (). +-- The returned TypecheckedHsExpr is of type IO [ Any ], a list of the bound +-- values, coerced to Any. tcRnStmt :: HscEnv -> GhciLStmt GhcPs -> IO (Messages TcRnMessage, Maybe ([Id], LHsExpr GhcTc, FixityEnv)) tcRnStmt hsc_env rdr_stmt @@ -2467,13 +2467,16 @@ The reason for -fno-it is explained in #14336. `it` can lead to the repl leaking memory as it is repeatedly queried. -} +any_lifted :: Type +any_lifted = anyTypeOfKind liftedTypeKind + -- | Typecheck the statements given and then return the results of the --- statement in the form 'IO [()]'. +-- statement in the form 'IO [Any]'. tcGhciStmts :: [GhciLStmt GhcRn] -> TcM PlanResult tcGhciStmts stmts = do { ioTyCon <- tcLookupTyCon ioTyConName ; ret_id <- tcLookupId returnIOName -- return @ IO - ; let ret_ty = mkListTy unitTy + ; let ret_ty = mkListTy any_lifted io_ret_ty = mkTyConApp ioTyCon [ret_ty] tc_io_stmts = tcStmtsAndThen (HsDoStmt GhciStmtCtxt) tcDoStmt stmts (mkCheckExpType io_ret_ty) @@ -2496,28 +2499,31 @@ tcGhciStmts stmts ; traceTc "GHC.Tc.Module.tcGhciStmts: done" empty -- ret_expr is the expression - -- returnIO @[()] [unsafeCoerce# () x, .., unsafeCoerce# () z] + -- returnIO @[Any] [unsafeCoerce# @Any x, .., unsafeCoerce# @Any z] -- -- Despite the inconvenience of building the type applications etc, -- this *has* to be done in type-annotated post-typecheck form -- because we are going to return a list of *polymorphic* values - -- coerced to type (). If we built a *source* stmt + -- coerced to type Any. If we built a *source* stmt -- return [coerce x, ..., coerce z] -- then the type checker would instantiate x..z, and we wouldn't -- get their *polymorphic* values. (And we'd get ambiguity errs -- if they were overloaded, since they aren't applied to anything.) + -- + -- We use Any rather than a dummy type such as () because of + -- the rules of unsafeCoerce#; see Unsafe/Coerce.hs for the details. ; AnId unsafe_coerce_id <- tcLookupGlobal unsafeCoercePrimName -- We use unsafeCoerce# here because of (U11) in -- Note [Implementing unsafeCoerce] in base:Unsafe.Coerce ; let ret_expr = nlHsApp (nlHsTyApp ret_id [ret_ty]) $ - noLocA $ ExplicitList unitTy $ + noLocA $ ExplicitList any_lifted $ map mk_item ids mk_item id = unsafe_coerce_id `nlHsTyApp` [ getRuntimeRep (idType id) - , getRuntimeRep unitTy - , idType id, unitTy] + , getRuntimeRep any_lifted + , idType id, any_lifted] `nlHsApp` nlHsVar id stmts = tc_stmts ++ [noLocA (mkLastStmt ret_expr)] ===================================== libraries/base/Unsafe/Coerce.hs ===================================== @@ -244,11 +244,11 @@ unsafeEqualityProof = case unsafeEqualityProof @a @b of UnsafeRefl -> UnsafeRefl -- Why delay inlining to Phase 1? Because of the RULES for map/unsafeCoerce; -- see (U8) in Note [Implementing unsafeCoerce] --- | Coerce a value from one type to another, bypassing the type-checker. +-- | `unsafeCoerce` coerces a value from one type to another, bypassing the type-checker. -- -- There are several legitimate ways to use 'unsafeCoerce': -- --- 1. To coerce e.g. @Int@ to @HValue@, put it in a list of @HValue@, +-- 1. To coerce a lifted type such as @Int@ to @Any@, put it in a list of @Any@, -- and then later coerce it back to @Int@ before using it. -- -- 2. To produce e.g. @(a+b) :~: (b+a)@ from @unsafeCoerce Refl at . @@ -269,15 +269,35 @@ unsafeEqualityProof = case unsafeEqualityProof @a @b of UnsafeRefl -> UnsafeRefl -- are the same -- but the proof of that relies on the complex, trusted -- implementation of @Typeable at . -- --- 4. The "reflection trick", which takes advantage of the fact that in +-- 4. (superseded) The "reflection trick", which takes advantage of the fact that in -- @class C a where { op :: ty }@, we can safely coerce between @C a@ and @ty@ -- (which have different kinds!) because it's really just a newtype. -- Note: there is /no guarantee, at all/ that this behavior will be supported -- into perpetuity. +-- It is now preferred to use `withDict` in @GHC.Magic.Dict@, which +-- is type-safe. See Note [withDict] in GHC.Tc.Instance.Class for details. -- +-- 5. (superseded) Casting between two types which have exactly the same structure: +-- between a newtype of T and T, or between types which differ only +-- in "phantom" type parameters. +-- It is now preferred to use `coerce` from @Data.Coerce@, which +-- is type-safe. -- --- For safe zero-cost coercions you can instead use the 'Data.Coerce.coerce' function from --- "Data.Coerce". +-- Other uses of 'unsafeCoerce' are undefined. In particular, you should not use +-- 'unsafeCoerce' to cast a T to an algebraic data type D, unless T is also +-- an algebraic data type. For example, do not cast @'Int'->'Int'@ to 'Bool', even if +-- you later cast that 'Bool' back to @'Int'->'Int'@ before applying it. The reasons +-- have to do with GHC's internal representation details (for the cognoscenti, data values +-- can be entered but function closures cannot). If you want a safe type to cast things +-- to, use 'Any', which is not an algebraic data type. + +-- NB. It is tempting to think that casting a value to a type that it doesn't have is safe +-- as long as you don't "do anything" with the value in its cast form, such as seq on it. This +-- isn't the case: the compiler can insert seqs itself, and if these happen at the wrong type, +-- Bad Things Might Happen. See bug #1616: in this case we cast a function of type (a,b) -> (a,b) +-- to () -> () and back again. The strictness analyser saw that the function was strict, but +-- the wrapper had type () -> (), and hence the wrapper de-constructed the (), the worker re-constructed +-- a new (), with the result that the code ended up with "case () of (a,b) -> ...". unsafeCoerce :: forall (a :: Type) (b :: Type) . a -> b unsafeCoerce x = case unsafeEqualityProof @a @b of UnsafeRefl -> x ===================================== testsuite/tests/ghci/should_run/T16096.stdout ===================================== @@ -13,12 +13,16 @@ letrec { x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in x; } in GHC.Base.returnIO - @[()] + @[GHC.Types.Any] (GHC.Types.: - @() + @GHC.Types.Any (Unsafe.Coerce.unsafeCoerce# - @GHC.Types.LiftedRep @GHC.Types.LiftedRep @[GHC.Types.Int] @() x) - (GHC.Types.[] @())) + @GHC.Types.LiftedRep + @GHC.Types.LiftedRep + @[GHC.Types.Int] + @GHC.Types.Any + x) + (GHC.Types.[] @GHC.Types.Any)) @@ -36,11 +40,15 @@ letrec { x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in x; } in GHC.Base.returnIO - @[()] + @[GHC.Types.Any] (GHC.Types.: - @() + @GHC.Types.Any (Unsafe.Coerce.unsafeCoerce# - @GHC.Types.LiftedRep @GHC.Types.LiftedRep @[GHC.Types.Int] @() x) - (GHC.Types.[] @())) + @GHC.Types.LiftedRep + @GHC.Types.LiftedRep + @[GHC.Types.Int] + @GHC.Types.Any + x) + (GHC.Types.[] @GHC.Types.Any)) ===================================== testsuite/tests/ghci/should_run/T21052.stdout ===================================== @@ -1,10 +1,10 @@ ==================== CodeGenInput STG: ==================== -BCO_toplevel :: GHC.Types.IO [()] +BCO_toplevel :: GHC.Types.IO [GHC.Types.Any] [LclId] = {} \u [] let { - sat :: [()] + sat :: [GHC.Types.Any] [LclId] = :! [GHC.Tuple.Prim.() GHC.Types.[]]; } in GHC.Base.returnIO sat; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b6dc079489950741808b12ee4bafbf60e837ffd5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b6dc079489950741808b12ee4bafbf60e837ffd5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 18:10:35 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 30 Mar 2023 14:10:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-opts Message-ID: <6425d09b46406_3483da258753a05887dc@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/hadrian-opts at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hadrian-opts You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 18:36:13 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 30 Mar 2023 14:36:13 -0400 Subject: [Git][ghc/ghc][master] 5 commits: Add {-# WARNING #-} to Data.List.{head,tail} Message-ID: <6425d69d2a2a3_3483da262e78c4597264@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 30 changed files: - compiler/GHC/Prelude/Basic.hs - compiler/GHC/ThToHs.hs - hadrian/src/Settings/Warnings.hs - libraries/base/Control/Monad/Fix.hs - libraries/base/Data/List/NonEmpty.hs - libraries/base/GHC/List.hs - libraries/base/changelog.md - libraries/hpc - libraries/xhtml - testsuite/tests/codeGen/should_compile/T3286.hs - testsuite/tests/deSugar/should_compile/ds025.hs - testsuite/tests/ghc-api/T10052/T10052.hs - testsuite/tests/ghci.debugger/scripts/T18045.hs - testsuite/tests/ghci.debugger/scripts/T18045.script - testsuite/tests/ghci.debugger/scripts/T18045.stdout - testsuite/tests/ghci.debugger/scripts/break009.script - testsuite/tests/ghci.debugger/scripts/break010.script - testsuite/tests/ghci.debugger/scripts/print001.script - testsuite/tests/ghci.debugger/scripts/print004.script - testsuite/tests/ghci.debugger/scripts/print028.script - testsuite/tests/ghci/caf_crash/D.hs - testsuite/tests/ghci/scripts/T10501.script - testsuite/tests/ghci/scripts/T16804.script - testsuite/tests/impredicative/PList1.hs - testsuite/tests/impredicative/PList2.hs - testsuite/tests/impredicative/boxy.hs - testsuite/tests/impredicative/icfp20-ok.hs - testsuite/tests/parser/should_compile/T13600b.hs - testsuite/tests/parser/should_compile/read024.hs - testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/98b5cf67f8428b0daefcbf5df121df0b8a126654...3d38dcb6e4b6ceeeeac79570faa42c33bfd10dfc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/98b5cf67f8428b0daefcbf5df121df0b8a126654...3d38dcb6e4b6ceeeeac79570faa42c33bfd10dfc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 18:36:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 30 Mar 2023 14:36:50 -0400 Subject: [Git][ghc/ghc][master] docs: move RecordUpd changelog entry to 9.8 Message-ID: <6425d6c262cc0_3483da2640bc78600554@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 2 changed files: - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst Changes: ===================================== docs/users_guide/9.6.1-notes.rst ===================================== @@ -215,11 +215,6 @@ Runtime system - Add `Foreign.C.Types.ConstPtr` was added to encode ``const``-qualified pointer return types in foreign declarations when using ``CApiFFI`` extension. -- The ``RecordUpd`` constructor of ``HsExpr`` now takes an ``HsRecUpdFields`` - instead of ``Either [LHsRecUpdField p] [LHsRecUpdProj p]``. - Instead of ``Left ..``, use the constructor ``RegularRecUpdFields``, and instead - of ``Right ..``, use the constructor ``OverloadedRecUpdFields``. - ``ghc-heap`` library ~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -93,6 +93,11 @@ Runtime system ``ghc`` library ~~~~~~~~~~~~~~~ +- The ``RecordUpd`` constructor of ``HsExpr`` now takes an ``HsRecUpdFields`` + instead of ``Either [LHsRecUpdField p] [LHsRecUpdProj p]``. + Instead of ``Left ..``, use the constructor ``RegularRecUpdFields``, and instead + of ``Right ..``, use the constructor ``OverloadedRecUpdFields``. + ``ghc-heap`` library ~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/930edcfd10f00d98c746f2198d59546034943ac6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/930edcfd10f00d98c746f2198d59546034943ac6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 18:37:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 30 Mar 2023 14:37:26 -0400 Subject: [Git][ghc/ghc][master] Add LANGUAGE GADTs to GHC.Rename.Env Message-ID: <6425d6e61a1ae_3483da26cc1fc060392f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 1 changed file: - compiler/GHC/Rename/Env.hs Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -1,5 +1,5 @@ - {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeApplications #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f885e6575eb741556d6e198d1a9dbdadf10307b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f885e6575eb741556d6e198d1a9dbdadf10307b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 19:29:07 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 30 Mar 2023 15:29:07 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.4.5-backports] 33 commits: ghc-the-library: Retain cafs in both static in dynamic builds. Message-ID: <6425e303744e7_3483da27dbdbbc6255b0@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-9.4.5-backports at Glasgow Haskell Compiler / GHC Commits: 5a0be129 by Andreas Klebinger at 2023-03-30T20:28:20+01:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) (cherry picked from commit 96ab827a0d1ffd81bd906262b42409f2df808375) - - - - - 7e2492db by sheaf at 2023-03-30T20:28:21+01:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 (cherry picked from commit cf564dd71548771394249e9bf959512a21bbcec0) (cherry picked from commit c17668466a404de8a7fc5ef5b2931790da9440b6) - - - - - f2b8c9d0 by Simon Peyton Jones at 2023-03-30T20:28:21+01:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 (cherry picked from commit 3d55d8ab51ece43c51055c43c9e7aba77cce46c0) - - - - - 56559c13 by Simon Peyton Jones at 2023-03-30T20:28:21+01:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - dd5b9e41 by Simon Peyton Jones at 2023-03-30T20:28:21+01:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 (cherry picked from commit 317f45c154f6fe25d50ef2f3febcc5883ff1b1ca) - - - - - e9484ce2 by Andreas Klebinger at 2023-03-30T20:28:21+01:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. (cherry picked from commit a1491c8791c57a64d94bc08d639d585815c8d4e2) - - - - - 02aefea2 by Matthew Pickering at 2023-03-30T20:28:21+01:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - aebaf47c by Matthew Pickering at 2023-03-30T20:28:21+01:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - 42ead57b by Matthew Pickering at 2023-03-30T20:28:21+01:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - 04028d00 by Sebastian Graf at 2023-03-30T20:28:21+01:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite (cherry picked from commit e3fff7512bbf989386faaa1dccafdad1deabde84) - - - - - b6c0f73b by Oleg Grenrus at 2023-03-30T20:28:21+01:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general (cherry picked from commit 1b812b6973a25cb1962e2fc543d2c4ed3cf31f3c) - - - - - 1d7331c9 by Viktor Dukhovni at 2023-03-30T20:28:21+01:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 (cherry picked from commit fc02f3bbb5f47f880465e22999ba9794f658d8f6) - - - - - 25ec9161 by Ryan Scott at 2023-03-30T20:28:21+01:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. (cherry picked from commit 4efee43db5090aac4dde1293357bdb548ae71c24) - - - - - fc9daf26 by Cheng Shao at 2023-03-30T20:28:21+01:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - 35cd8915 by Ben Gamari at 2023-03-30T20:28:21+01:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - 93f4714f by Ben Gamari at 2023-03-30T20:28:21+01:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - c1d3f423 by Ben Gamari at 2023-03-30T20:28:21+01:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 8dbb142a by Ben Gamari at 2023-03-30T20:28:21+01:00 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 17686ff4 by Zubin Duggal at 2023-03-30T20:28:21+01:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 (cherry picked from commit 68dd64ffa6f164dce4ac010b9f5e1adfefeae7c7) - - - - - 00f62d46 by Ben Gamari at 2023-03-30T20:28:21+01:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. (cherry picked from commit 8bed166bb79445f90015757fd5baac69a7b835df) - - - - - 0536cf91 by Zubin Duggal at 2023-03-30T20:28:21+01:00 bindist configure: Fail if find not found (#22691) (cherry picked from commit c9967d137cff83c7688e26f87a8b5e196a75ec93) - - - - - a44aaf08 by Ben Gamari at 2023-03-30T20:28:21+01:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. (cherry picked from commit 35a118001149eb8f5bab989be997757baa70bfec) - - - - - 832de361 by sheaf at 2023-03-30T20:28:21+01:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 (cherry picked from commit 9ee761bf02cdd11c955454a222c85971d95dce11) - - - - - b76f3218 by Ben Gamari at 2023-03-30T20:28:21+01:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. (cherry picked from commit db83f8bbf2e0ac68df675dea6b716fb7c19c649a) - - - - - 709249df by Ben Gamari at 2023-03-30T20:28:21+01:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. (cherry picked from commit 70999283156f527c5aea6dee57a3d14989a9903a) - - - - - 15f69661 by Ben Gamari at 2023-03-30T20:28:21+01:00 rts: Introduce stgMallocAlignedBytes (cherry picked from commit 5f7a4a6d8311d2faa9c90b2b0c4431dd4427839d) - - - - - c22a7a22 by Ben Gamari at 2023-03-30T20:28:21+01:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. (cherry picked from commit 8a6f745d963fc9b79c7b1e4b477f4fc724233655) - - - - - c14e490e by Ben Gamari at 2023-03-30T20:28:21+01:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. (cherry picked from commit 5464c73f192f76e75160e8992fe9720d943ae611) - - - - - baf26d2c by Ben Gamari at 2023-03-30T20:28:21+01: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. (cherry picked from commit 79ffa170a6b0b152da0e02744869311773733286) - - - - - 0967df48 by Andreas Klebinger at 2023-03-30T20:28:21+01:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 (cherry picked from commit 9296660b131d42f1b1f9c421040c5746d5c56989) - - - - - 6dd08703 by Matthew Pickering at 2023-03-30T20:28:21+01:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 (cherry picked from commit a86aae8b562c12bb3cee8dcae5156b647f1a74ad) - - - - - f8fc7720 by Sylvain Henry at 2023-03-30T20:28:21+01:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). (cherry picked from commit 4158722a6cff5d19e228356c525946b6c4b83396) - - - - - 23d4c60b by Ben Gamari at 2023-03-30T20:28:21+01:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. (cherry picked from commit b8d783d24b9a617ad1e3038abeb75d322703ef65) - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Solver/Types.hs - compiler/GHC/ThToHs.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.mk - configure.ac - distrib/configure.ac.in - docs/users_guide/using-optimisation.rst - hadrian/bindist/Makefile - libraries/base/GHC/Float.hs - + m4/fp_ld_no_fixup_chains.m4 - rts/Capability.c - rts/Capability.h - rts/Messages.h - rts/PrimOps.cmm - rts/Printer.c - rts/ProfHeap.c - rts/ProfilerReport.c - rts/ProfilerReportJson.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ec5901f4d91c053e2e996d682f5d7c4c697b731...23d4c60b1301f542d98b6df818cc9024b4bae1fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ec5901f4d91c053e2e996d682f5d7c4c697b731...23d4c60b1301f542d98b6df818cc9024b4bae1fb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 23:10:15 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 30 Mar 2023 19:10:15 -0400 Subject: [Git][ghc/ghc][wip/T13660] 4 commits: base: Move implementation of GHC.Foreign to GHC.Internal Message-ID: <642616d741cab_3483da2ba8c27865479f@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 4850ab82 by Ben Gamari at 2023-03-30T19:09:05-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 16826c77 by Ben Gamari at 2023-03-30T19:09:05-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - 6c7aa824 by Ben Gamari at 2023-03-30T19:09:05-04:00 base: Clean up documentation - - - - - 6625b5fc by Ben Gamari at 2023-03-30T19:09:05-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 4 changed files: - libraries/base/GHC/Foreign.hs - + libraries/base/GHC/Foreign/Internal.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal Changes: ===================================== libraries/base/GHC/Foreign.hs ===================================== @@ -21,312 +21,22 @@ module GHC.Foreign ( -- * C strings with a configurable encoding CString, CStringLen, - -- conversion of C strings into Haskell strings - -- + -- * Conversion of C strings into Haskell strings peekCString, peekCStringLen, - -- conversion of Haskell strings into C strings - -- + -- * Conversion of Haskell strings into C strings newCString, newCStringLen, + newCStringLen0, - -- conversion of Haskell strings into C strings using temporary storage - -- + -- * Conversion of Haskell strings into C strings using temporary storage withCString, withCStringLen, + withCStringLen0, withCStringsLen, charIsRepresentable, ) where -import Foreign.Marshal.Array -import Foreign.C.Types -import Foreign.Ptr -import Foreign.Storable - -import Data.Word - --- Imports for the locale-encoding version of marshallers - -import Data.Tuple (fst) - -import GHC.Show ( show ) - -import Foreign.Marshal.Alloc -import Foreign.ForeignPtr - -import GHC.Debug -import GHC.List -import GHC.Num -import GHC.Base - -import GHC.IO -import GHC.IO.Exception -import GHC.IO.Buffer -import GHC.IO.Encoding.Types - - -c_DEBUG_DUMP :: Bool -c_DEBUG_DUMP = False - -putDebugMsg :: String -> IO () -putDebugMsg | c_DEBUG_DUMP = debugLn - | otherwise = const (return ()) - - --- | A C string is a reference to an array of C characters terminated by NUL. -type CString = Ptr CChar - --- | A string with explicit length information in bytes instead of a --- terminating NUL (allowing NUL characters in the middle of the string). -type CStringLen = (Ptr CChar, Int) - --- exported functions --- ------------------ - --- | Marshal a NUL terminated C string into a Haskell string. --- -peekCString :: TextEncoding -> CString -> IO String -peekCString enc cp = do - sz <- lengthArray0 nUL cp - peekEncodedCString enc (cp, sz * cCharSize) - --- | Marshal a C string with explicit length into a Haskell string. --- -peekCStringLen :: TextEncoding -> CStringLen -> IO String -peekCStringLen = peekEncodedCString - --- | Marshal a Haskell string into a NUL terminated C string. --- --- * the Haskell string may /not/ contain any NUL characters --- --- * new storage is allocated for the C string and must be --- explicitly freed using 'Foreign.Marshal.Alloc.free' or --- 'Foreign.Marshal.Alloc.finalizerFree'. --- -newCString :: TextEncoding -> String -> IO CString -newCString enc = liftM fst . newEncodedCString enc True - --- | Marshal a Haskell string into a C string (ie, character array) with --- explicit length information. --- --- * new storage is allocated for the C string and must be --- explicitly freed using 'Foreign.Marshal.Alloc.free' or --- 'Foreign.Marshal.Alloc.finalizerFree'. --- -newCStringLen :: TextEncoding -> String -> IO CStringLen -newCStringLen enc = newEncodedCString enc False - --- | Marshal a Haskell string into a NUL terminated C string using temporary --- storage. --- --- * the Haskell string may /not/ contain any NUL characters --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a -withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp - --- | Marshal a Haskell string into a C string (ie, character array) --- in temporary storage, with explicit length information. --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a -withCStringLen enc = withEncodedCString enc False - --- | Marshal a list of Haskell strings into an array of NUL terminated C strings --- using temporary storage. --- --- * the Haskell strings may /not/ contain any NUL characters --- --- * the memory is freed when the subcomputation terminates (either --- normally or via an exception), so the pointer to the temporary --- storage must /not/ be used after this. --- -withCStringsLen :: TextEncoding - -> [String] - -> (Int -> Ptr CString -> IO a) - -> IO a -withCStringsLen enc strs f = go [] strs - where - go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss - go cs [] = withArrayLen (reverse cs) f - --- | Determines whether a character can be accurately encoded in a --- 'Foreign.C.String.CString'. --- --- Pretty much anyone who uses this function is in a state of sin because --- whether or not a character is encodable will, in general, depend on the --- context in which it occurs. -charIsRepresentable :: TextEncoding -> Char -> IO Bool --- We force enc explicitly because `catch` is lazy in its --- first argument. We would probably like to force c as well, --- but unfortunately worker/wrapper produces very bad code for --- that. --- --- TODO If this function is performance-critical, it would probably --- pay to use a single-character specialization of withCString. That --- would allow worker/wrapper to actually eliminate Char boxes, and --- would also get rid of the completely unnecessary cons allocation. -charIsRepresentable !enc c = - withCString enc [c] - (\cstr -> do str <- peekCString enc cstr - case str of - [ch] | ch == c -> pure True - _ -> pure False) - `catch` - \(_ :: IOException) -> pure False - --- auxiliary definitions --- ---------------------- - --- C's end of string character -nUL :: CChar -nUL = 0 - --- Size of a CChar in bytes -cCharSize :: Int -cCharSize = sizeOf (undefined :: CChar) - - -{-# INLINE peekEncodedCString #-} -peekEncodedCString :: TextEncoding -- ^ Encoding of CString - -> CStringLen - -> IO String -- ^ String in Haskell terms -peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes) - = bracket mk_decoder close $ \decoder -> do - let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII - !from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p) - !to <- newCharBuffer chunk_size WriteBuffer - - let go !iteration !from = do - (why, from', !to') <- encode decoder from to - if isEmptyBuffer from' - then - -- No input remaining: @why@ will be InputUnderflow, but we don't care - withBuffer to' $ peekArray (bufferElems to') - else do - -- Input remaining: what went wrong? - putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why) - (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because - InputUnderflow -> recover decoder from' to' -- they indicate malformed/truncated input - OutputUnderflow -> return (from', to') -- We will have more space next time round - putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'') - putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'') - to_chars <- withBuffer to'' $ peekArray (bufferElems to'') - fmap (to_chars++) $ go (iteration + 1) from'' - - go (0 :: Int) from0 - -{-# INLINE withEncodedCString #-} -withEncodedCString :: TextEncoding -- ^ Encoding of CString to create - -> Bool -- ^ Null-terminate? - -> String -- ^ String to encode - -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory - -> IO a -withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act - = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do - from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p - - let go !iteration to_sz_bytes = do - putDebugMsg ("withEncodedCString: " ++ show iteration) - allocaBytes to_sz_bytes $ \to_p -> do - -- See Note [Check *before* fill in withEncodedCString] about why - -- this is subtle. - mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes - case mb_res of - Nothing -> go (iteration + 1) (to_sz_bytes * 2) - Just to_buf -> withCStringBuffer to_buf null_terminate act - - -- If the input string is ASCII, this value will ensure we only allocate once - go (0 :: Int) (cCharSize * (sz + 1)) - -withCStringBuffer :: Buffer Word8 -> Bool -> (CStringLen -> IO r) -> IO r -withCStringBuffer to_buf null_terminate act = do - let bytes = bufferElems to_buf - withBuffer to_buf $ \to_ptr -> do - when null_terminate $ pokeElemOff to_ptr (bufR to_buf) 0 - act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes* - -{-# INLINE newEncodedCString #-} -newEncodedCString :: TextEncoding -- ^ Encoding of CString to create - -> Bool -- ^ Null-terminate? - -> String -- ^ String to encode - -> IO CStringLen -newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s - = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do - from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p - - let go !iteration to_p to_sz_bytes = do - putDebugMsg ("newEncodedCString: " ++ show iteration) - mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes - case mb_res of - Nothing -> do - let to_sz_bytes' = to_sz_bytes * 2 - to_p' <- reallocBytes to_p to_sz_bytes' - go (iteration + 1) to_p' to_sz_bytes' - Just to_buf -> withCStringBuffer to_buf null_terminate return - - -- If the input string is ASCII, this value will ensure we only allocate once - let to_sz_bytes = cCharSize * (sz + 1) - to_p <- mallocBytes to_sz_bytes - go (0 :: Int) to_p to_sz_bytes - - -tryFillBuffer :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int - -> IO (Maybe (Buffer Word8)) -tryFillBuffer encoder null_terminate from0 to_p !to_sz_bytes = do - !to_fp <- newForeignPtr_ to_p - go (0 :: Int) from0 (emptyBuffer to_fp to_sz_bytes WriteBuffer) - where - go !iteration !from !to = do - (why, from', to') <- encode encoder from to - putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from') - if isEmptyBuffer from' - then if null_terminate && bufferAvailable to' == 0 - then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer - else return (Just to') - else case why of -- We didn't consume all of the input - InputUnderflow -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- These conditions are equally bad - InvalidSequence -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- since the input was truncated/invalid - OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more -{- -Note [Check *before* fill in withEncodedCString] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's very important that the size check and readjustment peformed by tryFillBuffer -happens before the continuation is called. The size check is the part which can -fail, the call to the continuation never fails and so the caller should respond -first to the size check failing and *then* call the continuation. Making this evident -to the compiler avoids historic space leaks. - -In a previous iteration of this code we had a pattern that, somewhat simplified, -looked like this: - -go :: State -> (State -> IO a) -> IO a -go state action = - case tryFillBufferAndCall state action of - Left state' -> go state' action - Right result -> result - -`tryFillBufferAndCall` performed some checks, and then we either called action, -or we modified the state and tried again. -This went wrong because `action` can be a function closure containing a reference to -a lazy data structure. If we call action directly, without retaining any references -to action, that is fine. The data structure is consumed as it is produced and we operate -in constant space. - -However the failure branch `go state' action` *does* capture a reference to action. -This went wrong because the reference to action in the failure branch only becomes -unreachable *after* action returns. This means we keep alive the function closure -for `action` until `action` returns. Which in turn keeps alive the *whole* lazy list -via `action` until the action has fully run. -This went wrong in #20107, where the continuation kept an entire lazy bytestring alive -rather than allowing it to be incrementally consumed and collected. --} - +import GHC.Foreign.Internal ===================================== libraries/base/GHC/Foreign/Internal.hs ===================================== @@ -0,0 +1,357 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Foreign.Internal +-- Copyright : (c) The University of Glasgow, 2008-2011 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : libraries at haskell.org +-- Stability : internal +-- Portability : non-portable +-- +-- Foreign marshalling support for CStrings with configurable encodings +-- +----------------------------------------------------------------------------- + +module GHC.Foreign.Internal ( + -- * C strings with a configurable encoding + CString, CStringLen, + + -- * Conversion of C strings into Haskell strings + peekCString, + peekCStringLen, + + -- * Conversion of Haskell strings into C strings + newCString, + newCStringLen, + newCStringLen0, + + -- * Conversion of Haskell strings into C strings using temporary storage + withCString, + withCStringLen, + withCStringLen0, + withCStringsLen, + + charIsRepresentable, + ) where + +import Foreign.Marshal.Array +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Storable + +import Data.Word + +-- Imports for the locale-encoding version of marshallers + +import Data.Tuple (fst) + +import GHC.Show ( show ) + +import Foreign.Marshal.Alloc +import Foreign.ForeignPtr + +import GHC.Debug +import GHC.List +import GHC.Num +import GHC.Base + +import GHC.IO +import GHC.IO.Exception +import GHC.IO.Buffer +import GHC.IO.Encoding.Types + + +c_DEBUG_DUMP :: Bool +c_DEBUG_DUMP = False + +putDebugMsg :: String -> IO () +putDebugMsg | c_DEBUG_DUMP = debugLn + | otherwise = const (return ()) + + +-- | A C string is a reference to an array of C characters terminated by NUL. +type CString = Ptr CChar + +-- | A string with explicit length information in bytes instead of a +-- terminating NUL (allowing NUL characters in the middle of the string). +type CStringLen = (Ptr CChar, Int) + +-- exported functions +-- ------------------ + +-- | Marshal a NUL terminated C string into a Haskell string. +-- +peekCString :: TextEncoding -> CString -> IO String +peekCString enc cp = do + sz <- lengthArray0 nUL cp + peekEncodedCString enc (cp, sz * cCharSize) + +-- | Marshal a C string with explicit length into a Haskell string. +-- +peekCStringLen :: TextEncoding -> CStringLen -> IO String +peekCStringLen = peekEncodedCString + +-- | Marshal a Haskell string into a NUL terminated C string. +-- +-- * the Haskell string may /not/ contain any NUL characters +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +newCString :: TextEncoding -> String -> IO CString +newCString enc = liftM fst . newEncodedCString enc True + +-- | Marshal a Haskell string into a C string (ie, character array) with +-- explicit length information. +-- +-- Note that this does not NUL terminate the resulting string. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +newCStringLen :: TextEncoding -> String -> IO CStringLen +newCStringLen enc = newEncodedCString enc False + +-- | Marshal a Haskell string into a NUL terminated C string using temporary +-- storage. +-- +-- * the Haskell string may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a +withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp + +-- | Marshal a Haskell string into a C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- Note that this does not NUL terminate the resulting string. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringLen :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen enc = withEncodedCString enc False + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- with explicit length information. +-- +-- * new storage is allocated for the C string and must be +-- explicitly freed using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree'. +-- +-- @since 4.19.0.0 +newCStringLen0 :: TextEncoding -> String -> IO CStringLen +newCStringLen0 enc = newEncodedCString enc True + +-- | Marshal a Haskell string into a NUL-terminated C string (ie, character array) +-- in temporary storage, with explicit length information. +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +-- @since 4.19.0.0 +withCStringLen0 :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a +withCStringLen0 enc = withEncodedCString enc True + +-- | Marshal a list of Haskell strings into an array of NUL terminated C strings +-- using temporary storage. +-- +-- * the Haskell strings may /not/ contain any NUL characters +-- +-- * the memory is freed when the subcomputation terminates (either +-- normally or via an exception), so the pointer to the temporary +-- storage must /not/ be used after this. +-- +withCStringsLen :: TextEncoding + -> [String] + -> (Int -> Ptr CString -> IO a) + -> IO a +withCStringsLen enc strs f = go [] strs + where + go cs (s:ss) = withCString enc s $ \c -> go (c:cs) ss + go cs [] = withArrayLen (reverse cs) f + +-- | Determines whether a character can be accurately encoded in a +-- 'Foreign.C.String.CString'. +-- +-- Pretty much anyone who uses this function is in a state of sin because +-- whether or not a character is encodable will, in general, depend on the +-- context in which it occurs. +charIsRepresentable :: TextEncoding -> Char -> IO Bool +-- We force enc explicitly because `catch` is lazy in its +-- first argument. We would probably like to force c as well, +-- but unfortunately worker/wrapper produces very bad code for +-- that. +-- +-- TODO If this function is performance-critical, it would probably +-- pay to use a single-character specialization of withCString. That +-- would allow worker/wrapper to actually eliminate Char boxes, and +-- would also get rid of the completely unnecessary cons allocation. +charIsRepresentable !enc c = + withCString enc [c] + (\cstr -> do str <- peekCString enc cstr + case str of + [ch] | ch == c -> pure True + _ -> pure False) + `catch` + \(_ :: IOException) -> pure False + +-- auxiliary definitions +-- ---------------------- + +-- C's end of string character +nUL :: CChar +nUL = 0 + +-- Size of a CChar in bytes +cCharSize :: Int +cCharSize = sizeOf (undefined :: CChar) + + +{-# INLINE peekEncodedCString #-} +peekEncodedCString :: TextEncoding -- ^ Encoding of CString + -> CStringLen + -> IO String -- ^ String in Haskell terms +peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes) + = bracket mk_decoder close $ \decoder -> do + let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII + !from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p) + !to <- newCharBuffer chunk_size WriteBuffer + + let go !iteration !from = do + (why, from', !to') <- encode decoder from to + if isEmptyBuffer from' + then + -- No input remaining: @why@ will be InputUnderflow, but we don't care + withBuffer to' $ peekArray (bufferElems to') + else do + -- Input remaining: what went wrong? + putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why) + (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because + InputUnderflow -> recover decoder from' to' -- they indicate malformed/truncated input + OutputUnderflow -> return (from', to') -- We will have more space next time round + putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'') + putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'') + to_chars <- withBuffer to'' $ peekArray (bufferElems to'') + fmap (to_chars++) $ go (iteration + 1) from'' + + go (0 :: Int) from0 + +{-# INLINE withEncodedCString #-} +withEncodedCString :: TextEncoding -- ^ Encoding of CString to create + -> Bool -- ^ Null-terminate? + -> String -- ^ String to encode + -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory + -> IO a +withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act + = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do + from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p + + let go !iteration to_sz_bytes = do + putDebugMsg ("withEncodedCString: " ++ show iteration) + allocaBytes to_sz_bytes $ \to_p -> do + -- See Note [Check *before* fill in withEncodedCString] about why + -- this is subtle. + mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes + case mb_res of + Nothing -> go (iteration + 1) (to_sz_bytes * 2) + Just to_buf -> withCStringBuffer to_buf null_terminate act + + -- If the input string is ASCII, this value will ensure we only allocate once + go (0 :: Int) (cCharSize * (sz + 1)) + +withCStringBuffer :: Buffer Word8 -> Bool -> (CStringLen -> IO r) -> IO r +withCStringBuffer to_buf null_terminate act = do + let bytes = bufferElems to_buf + withBuffer to_buf $ \to_ptr -> do + when null_terminate $ pokeElemOff to_ptr (bufR to_buf) 0 + act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes* + +{-# INLINE newEncodedCString #-} +newEncodedCString :: TextEncoding -- ^ Encoding of CString to create + -> Bool -- ^ Null-terminate? + -> String -- ^ String to encode + -> IO CStringLen +newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s + = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do + from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p + + let go !iteration to_p to_sz_bytes = do + putDebugMsg ("newEncodedCString: " ++ show iteration) + mb_res <- tryFillBuffer encoder null_terminate from to_p to_sz_bytes + case mb_res of + Nothing -> do + let to_sz_bytes' = to_sz_bytes * 2 + to_p' <- reallocBytes to_p to_sz_bytes' + go (iteration + 1) to_p' to_sz_bytes' + Just to_buf -> withCStringBuffer to_buf null_terminate return + + -- If the input string is ASCII, this value will ensure we only allocate once + let to_sz_bytes = cCharSize * (sz + 1) + to_p <- mallocBytes to_sz_bytes + go (0 :: Int) to_p to_sz_bytes + + +tryFillBuffer :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int + -> IO (Maybe (Buffer Word8)) +tryFillBuffer encoder null_terminate from0 to_p !to_sz_bytes = do + !to_fp <- newForeignPtr_ to_p + go (0 :: Int) from0 (emptyBuffer to_fp to_sz_bytes WriteBuffer) + where + go !iteration !from !to = do + (why, from', to') <- encode encoder from to + putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from') + if isEmptyBuffer from' + then if null_terminate && bufferAvailable to' == 0 + then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer + else return (Just to') + else case why of -- We didn't consume all of the input + InputUnderflow -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- These conditions are equally bad + InvalidSequence -> recover encoder from' to' >>= \(a,b) -> go (iteration + 1) a b -- since the input was truncated/invalid + OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more +{- +Note [Check *before* fill in withEncodedCString] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's very important that the size check and readjustment peformed by tryFillBuffer +happens before the continuation is called. The size check is the part which can +fail, the call to the continuation never fails and so the caller should respond +first to the size check failing and *then* call the continuation. Making this evident +to the compiler avoids historic space leaks. + +In a previous iteration of this code we had a pattern that, somewhat simplified, +looked like this: + +go :: State -> (State -> IO a) -> IO a +go state action = + case tryFillBufferAndCall state action of + Left state' -> go state' action + Right result -> result + +`tryFillBufferAndCall` performed some checks, and then we either called action, +or we modified the state and tried again. +This went wrong because `action` can be a function closure containing a reference to +a lazy data structure. If we call action directly, without retaining any references +to action, that is fine. The data structure is consumed as it is produced and we operate +in constant space. + +However the failure branch `go state' action` *does* capture a reference to action. +This went wrong because the reference to action in the failure branch only becomes +unreachable *after* action returns. This means we keep alive the function closure +for `action` until `action` returns. Which in turn keeps alive the *whole* lazy list +via `action` until the action has fully run. +This went wrong in #20107, where the continuation kept an entire lazy bytestring alive +rather than allowing it to be incrementally consumed and collected. +-} + ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -43,6 +43,7 @@ import System.IO.Error import GHC.Base import GHC.Num +import GHC.Ptr import GHC.Real import GHC.IO import GHC.IO.IOMode @@ -164,13 +165,22 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls fp = when ('\0' `elem` fp) (throwInternalNulError fp) #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,13 +188,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen0 enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen0 enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = + when (len' /= len) (throwInternalNulError fp) + -- N.B. If the string contains internal NUL codeunits then the strlen will + -- indicate a size smaller than that returned by withCStringLen. + where + len' = case str of Ptr ptr -> I# (cstringLength# ptr) #endif +throwInternalNulError :: FilePath -> IO a +throwInternalNulError fp = ioError err + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "FilePaths must not contain internal NUL code units." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + -- --------------------------------------------------------------------------- -- Terminal-related stuff ===================================== libraries/base/base.cabal ===================================== @@ -351,6 +351,7 @@ Library GHC.Event.IntVar GHC.Event.PSQ GHC.Event.Unique + GHC.Foreign.Internal -- GHC.IOPort -- TODO: hide again after debug GHC.Unicode.Internal.Bits GHC.Unicode.Internal.Char.DerivedCoreProperties View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9847f8eb9a406860bd532bc5efba1cb1a4b891f4...6625b5fc91b4771971826b4bc245a24e7fc2b245 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9847f8eb9a406860bd532bc5efba1cb1a4b891f4...6625b5fc91b4771971826b4bc245a24e7fc2b245 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Mar 30 23:34:09 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 30 Mar 2023 19:34:09 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] 23 commits: Make exprIsConApp_maybe a bit cleverer Message-ID: <64261c71b0f85_3483da2c2b220465539d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 51af5d58 by Simon Peyton Jones at 2023-03-30T23:16:25+01:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 6050255e by Simon Peyton Jones at 2023-03-30T23:16:25+01:00 Never quantify over equalities in an inferred type An experiment.. trying to do the Right Thing! Examples * #22194 * `histogram_` in Statistics.Sample.Histogram in `statistics` - - - - - 84a85294 by Simon Peyton Jones at 2023-03-30T23:16:26+01:00 Typos and comments - - - - - c2bbef2a by Simon Peyton Jones at 2023-03-30T23:16:26+01:00 Add a type signature in isAtomicHsExpr - - - - - b1b7d9b6 by Simon Peyton Jones at 2023-03-30T23:16:26+01:00 Allow quantification over equalities at top level (only) - - - - - 35bc5c05 by Simon Peyton Jones at 2023-03-30T23:16:26+01:00 Make pickQuantifiablePred more generous - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/FastString/Env.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0b325769f19dda81cad82de768e9f8563ec8273...35bc5c05c328ede092e971320b110caac8df51af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0b325769f19dda81cad82de768e9f8563ec8273...35bc5c05c328ede092e971320b110caac8df51af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 07:10:14 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 31 Mar 2023 03:10:14 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Wibble Message-ID: <6426875685a71_3483da33952ea46756b5@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 3948dc03 by Simon Peyton Jones at 2023-03-31T08:11:41+01:00 Wibble - - - - - 3 changed files: - compiler/GHC/Tc/Solver.hs - + testsuite/tests/typecheck/should_compile/T22194.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1938,14 +1938,11 @@ pickQuantifiablePreds -- quantified over, given the type variables that are being quantified pickQuantifiablePreds qtvs theta = do { tc_lvl <- TcM.getTcLevel - ; flex_ctxt <- xoptM LangExt.FlexibleContexts --- flex_ctxt = True in -- Quantify over non-tyvar constraints, even without --- -- -XFlexibleContexts: see #10608, #10351 ; let is_nested = not (isTopTcLevel tc_lvl) ; return (mkMinimalBySCs id $ -- See Note [Minimize by Superclasses] - mapMaybe (pick_me is_nested flex_ctxt) theta) } + mapMaybe (pick_me is_nested True) theta) } where - pick_me is_nested flex_ctxt pred + pick_me is_nested _flex_ctxt pred = case classifyPredType pred of ClassPred cls tys @@ -1967,10 +1964,8 @@ pickQuantifiablePreds qtvs theta -> Just pred -- From here on, we are thinking about top-level defns only - | checkValidClsArgs flex_ctxt cls tys - -- Only quantify over predicates that checkValidType - -- will pass! See #10351. - , no_fixed_dependencies cls tys + | no_fixed_dependencies cls tys + -- See Note [Do not quantify over constraints that determine a variable] -> Just pred | otherwise @@ -2011,6 +2006,8 @@ pickQuantifiablePreds qtvs theta -> tyCoVarsOfTypes tys `intersectsVarSet` qtvs _ -> False +-- flex_ctxt = True in -- Quantify over non-tyvar constraints, even without +-- -- -XFlexibleContexts: see #10608, #10351 ------------------ growThetaTyVars :: ThetaType -> TyCoVarSet -> TyCoVarSet ===================================== testsuite/tests/typecheck/should_compile/T22194.hs ===================================== @@ -0,0 +1,64 @@ +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MagicHash, UnboxedTuples #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE NoMonoLocalBinds #-} + +module Test where + +import Data.Kind +import GHC.Exts + +--import Control.Monad.Primitive -- primitive-0.7.4.0 +--import Data.Primitive.MutVar -- primitive-0.7.4.0 + +class Monad m => PrimMonad m where + type PrimState m + primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a + +data MutVar s a = MutVar (MutVar# s a) + +newMutVar :: PrimMonad m => a -> m (MutVar (PrimState m) a) +newMutVar = error "urk" + +writeMutVar :: PrimMonad m => MutVar (PrimState m) a -> a -> m () +writeMutVar = error "Urk" + +----------- + +class Monad m => New a m where + new :: m a + +class Monad m => Add a m e | a -> e where + add :: a -> e -> m () + +data T (m :: Type -> Type) = T + +instance PrimMonad m => New (T m) m where + new = return T + +instance PrimMonad m => Add (T m) m Int where + add _ _ = return () + +test1 :: forall m. PrimMonad m => m () +test1 = do + ref <- newMutVar (undefined :: T m) + let g () = do + t <- new + add t (0 :: Int) + writeMutVar ref t + g () + +test2 :: forall m. PrimMonad m => m () +test2 = do + (ref :: MutVar (PrimState m) (T m)) <- newMutVar undefined + let g () = do + t <- new + add t (0 :: Int) + writeMutVar ref t + g () ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -867,6 +867,7 @@ test('T23018', normal, compile, ['']) test('T21909', normal, compile, ['']) test('T21909b', normal, compile, ['']) test('T21443', normal, compile, ['']) +test('T22194', normal, compile, ['']) test('QualifiedRecordUpdate', [ extra_files(['QualifiedRecordUpdate_aux.hs']) ] , multimod_compile, ['QualifiedRecordUpdate', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3948dc03dc3955c1c10a26fdfd4b12bbff8ff43a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3948dc03dc3955c1c10a26fdfd4b12bbff8ff43a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 09:46:21 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 31 Mar 2023 05:46:21 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Major refactor in the handling of equality constraints Message-ID: <6426abed2c114_3483da361b682870885d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 21d18997 by Simon Peyton Jones at 2023-03-31T10:47:47+01:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 20 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/21d1899776d24d0aad9aae26d46edd26ccfeef3d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/21d1899776d24d0aad9aae26d46edd26ccfeef3d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 09:46:38 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Fri, 31 Mar 2023 05:46:38 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.4.5-backports] 36 commits: Windows: Remove mingwex dependency Message-ID: <6426abfe64bd3_3483da361e920070974b@gitlab.mail> Zubin pushed to branch wip/ghc-9.4.5-backports at Glasgow Haskell Compiler / GHC Commits: df45945e by Ryan Scott at 2023-03-31T15:15:41+05:30 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` (cherry picked from commit de1d15127ac3f41ac3044215b0ea3398a36edc89) - - - - - b7805515 by Tamar Christina at 2023-03-31T15:15:42+05:30 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. (cherry picked from commit 48e391952c17ff7eab10b0b1456e3f2a2af28a9b) - - - - - 7cdfc92c by Ben Gamari at 2023-03-31T15:15:42+05:30 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. (cherry picked from commit b2bb3e62275cc1d9e00a2d5ed511843192133ed5) - - - - - 0eb0d43a by Andreas Klebinger at 2023-03-31T15:15:42+05:30 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- (cherry picked from commit 08ba87200ff068aa37cac082e61ee7e2d534daf5) (cherry picked from commit 96ab827a0d1ffd81bd906262b42409f2df808375) - - - - - f4c0d6ad by sheaf at 2023-03-31T15:15:42+05:30 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 (cherry picked from commit cf564dd71548771394249e9bf959512a21bbcec0) (cherry picked from commit c17668466a404de8a7fc5ef5b2931790da9440b6) - - - - - e4042a4b by Simon Peyton Jones at 2023-03-31T15:15:42+05:30 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 (cherry picked from commit 3d55d8ab51ece43c51055c43c9e7aba77cce46c0) - - - - - 743cb177 by Simon Peyton Jones at 2023-03-31T15:15:42+05:30 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. (cherry picked from commit e193e53790dd5886feea3cf4c9c17625d188291b) - - - - - 8c143b8d by Simon Peyton Jones at 2023-03-31T15:15:42+05:30 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 (cherry picked from commit 317f45c154f6fe25d50ef2f3febcc5883ff1b1ca) - - - - - 20b627a4 by Andreas Klebinger at 2023-03-31T15:15:43+05:30 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. (cherry picked from commit a1491c8791c57a64d94bc08d639d585815c8d4e2) - - - - - 2fe32a88 by Matthew Pickering at 2023-03-31T15:15:43+05:30 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s (cherry picked from commit a960ca817d6ad0109ea6edda50da3902cc538e86) - - - - - 3a7e6203 by Matthew Pickering at 2023-03-31T15:15:43+05:30 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. (cherry picked from commit 734847108420cf826a807c30ad54651659cf3a08) - - - - - 6cafdbbc by Matthew Pickering at 2023-03-31T15:15:43+05:30 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes (cherry picked from commit 8c0ea25fb4a27d4729aabf73f4c00b912bb0c58d) - - - - - 6f7cf009 by Sebastian Graf at 2023-03-31T15:15:43+05:30 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite (cherry picked from commit e3fff7512bbf989386faaa1dccafdad1deabde84) - - - - - 5049a0ac by Oleg Grenrus at 2023-03-31T15:15:43+05:30 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general (cherry picked from commit 1b812b6973a25cb1962e2fc543d2c4ed3cf31f3c) - - - - - 6e17bb6f by Viktor Dukhovni at 2023-03-31T15:15:43+05:30 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 (cherry picked from commit fc02f3bbb5f47f880465e22999ba9794f658d8f6) - - - - - aacd4a3b by Ryan Scott at 2023-03-31T15:15:43+05:30 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. (cherry picked from commit 4efee43db5090aac4dde1293357bdb548ae71c24) - - - - - ad856385 by Cheng Shao at 2023-03-31T15:15:43+05:30 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. (cherry picked from commit c45a5fffef2c76efbf5d3a009c3f6d0244a63f0d) - - - - - fd1e63a9 by Ben Gamari at 2023-03-31T15:15:43+05:30 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. (cherry picked from commit be417a47c7695998dea0adc05489a7b8838a78b6) - - - - - 7f7ffa06 by Ben Gamari at 2023-03-31T15:15:43+05:30 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. (cherry picked from commit 30989d137b8f3a8fddbfd116e04b48f23c24f86c) - - - - - 84d4e171 by Ben Gamari at 2023-03-31T15:15:43+05:30 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. (cherry picked from commit 7566fd9de38c67360c090f828923d41587af519c) - - - - - 5550a573 by Ben Gamari at 2023-03-31T15:15:43+05:30 testsuite: Add regression test for #22798 (cherry picked from commit 2cb500a5ee1a31dfe1a2cdd71f175442026eb082) - - - - - 70330a57 by Zubin Duggal at 2023-03-31T15:15:43+05:30 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 (cherry picked from commit 68dd64ffa6f164dce4ac010b9f5e1adfefeae7c7) - - - - - ed4831eb by Ben Gamari at 2023-03-31T15:15:43+05:30 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. (cherry picked from commit 8bed166bb79445f90015757fd5baac69a7b835df) - - - - - 713f8481 by Zubin Duggal at 2023-03-31T15:15:43+05:30 bindist configure: Fail if find not found (#22691) (cherry picked from commit c9967d137cff83c7688e26f87a8b5e196a75ec93) - - - - - dbc76aa5 by Ben Gamari at 2023-03-31T15:15:43+05:30 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. (cherry picked from commit 35a118001149eb8f5bab989be997757baa70bfec) - - - - - 726fa59b by sheaf at 2023-03-31T15:15:43+05:30 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 (cherry picked from commit 9ee761bf02cdd11c955454a222c85971d95dce11) - - - - - 5caf66d0 by Ben Gamari at 2023-03-31T15:15:44+05:30 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. (cherry picked from commit db83f8bbf2e0ac68df675dea6b716fb7c19c649a) - - - - - b3a03f64 by Ben Gamari at 2023-03-31T15:15:44+05:30 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. (cherry picked from commit 70999283156f527c5aea6dee57a3d14989a9903a) - - - - - e6fd538f by Ben Gamari at 2023-03-31T15:15:44+05:30 rts: Introduce stgMallocAlignedBytes (cherry picked from commit 5f7a4a6d8311d2faa9c90b2b0c4431dd4427839d) - - - - - ab097312 by Ben Gamari at 2023-03-31T15:15:44+05:30 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. (cherry picked from commit 8a6f745d963fc9b79c7b1e4b477f4fc724233655) - - - - - bffed287 by Ben Gamari at 2023-03-31T15:15:44+05:30 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. (cherry picked from commit 5464c73f192f76e75160e8992fe9720d943ae611) - - - - - 8e9cf057 by Ben Gamari at 2023-03-31T15:15:44+05:30 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. (cherry picked from commit 79ffa170a6b0b152da0e02744869311773733286) - - - - - 64f4cfae by Andreas Klebinger at 2023-03-31T15:15:44+05:30 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 (cherry picked from commit 9296660b131d42f1b1f9c421040c5746d5c56989) - - - - - bef507df by Matthew Pickering at 2023-03-31T15:15:44+05:30 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 (cherry picked from commit a86aae8b562c12bb3cee8dcae5156b647f1a74ad) - - - - - 68976461 by Sylvain Henry at 2023-03-31T15:15:44+05:30 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). (cherry picked from commit 4158722a6cff5d19e228356c525946b6c4b83396) - - - - - 4b4a34a7 by Ben Gamari at 2023-03-31T15:15:44+05:30 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. (cherry picked from commit b8d783d24b9a617ad1e3038abeb75d322703ef65) - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Solver/Types.hs - compiler/GHC/ThToHs.hs - compiler/cbits/keepCAFsForGHCi.c - compiler/ghc.mk - configure.ac - distrib/configure.ac.in - docs/users_guide/using-optimisation.rst - hadrian/bindist/Makefile - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Settings/Packages.hs - libraries/base/GHC/Float.hs - libraries/base/System/Posix/Internals.hs - libraries/base/base.cabal - libraries/base/configure.ac - libraries/base/include/HsBase.h - libraries/ghc-prim/ghc-prim.cabal The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/23d4c60b1301f542d98b6df818cc9024b4bae1fb...4b4a34a758349e569e1dc1775967e7ef32e7fff9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/23d4c60b1301f542d98b6df818cc9024b4bae1fb...4b4a34a758349e569e1dc1775967e7ef32e7fff9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 10:14:25 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 31 Mar 2023 06:14:25 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Major refactor in the handling of equality constraints Message-ID: <6426b2816d2ea_3483da36b2f6847156df@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 03b3e066 by Simon Peyton Jones at 2023-03-31T11:15:54+01:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 20 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03b3e0666e525b636c1d7ebf97a6e903677b39a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03b3e0666e525b636c1d7ebf97a6e903677b39a7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 10:20:38 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 31 Mar 2023 06:20:38 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Major refactor in the handling of equality constraints Message-ID: <6426b3f6a3c07_3483da36be08087182d5@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: 2e865058 by Simon Peyton Jones at 2023-03-31T11:22:06+01:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 20 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e8650585eb393b9218181134a8d01a200606371 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e8650585eb393b9218181134a8d01a200606371 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 11:26:40 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 31 Mar 2023 07:26:40 -0400 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] 134 commits: Fix typo in docs referring to threadLabel Message-ID: <6426c370db024_3483da37e84838736770@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - d64bd33e by Sven Tennie at 2023-03-30T16:57:39+00:00 ghc-heap: Decode StgStack and its frames Previously, ghc-heap could only decode heap closures. The approach is explained in detail in note [Decoding the stack]. - - - - - f7ecd206 by Sven Tennie at 2023-03-30T16:57:39+00:00 Splitting StackFrames from Closures: Compiles - - - - - ee481625 by Sven Tennie at 2023-03-30T16:57:39+00:00 Fix tests - - - - - c7f33135 by Sven Tennie at 2023-03-31T11:26:03+00:00 Validate - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitmodules - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/CmmToLlvm/Ppr.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Linker/Loader.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/980faf2bb5f3552f8040aefdf2404ec8c8d36ee4...c7f3313573c114076cb5c37ce031a35d8cc7df9d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/980faf2bb5f3552f8040aefdf2404ec8c8d36ee4...c7f3313573c114076cb5c37ce031a35d8cc7df9d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 11:55:58 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 31 Mar 2023 07:55:58 -0400 Subject: [Git][ghc/ghc][wip/bootstrap-9_6] ci: Add job to test 9.6 bootstrapping Message-ID: <6426ca4ef3c55_3483da3893791074374f@gitlab.mail> Matthew Pickering pushed to branch wip/bootstrap-9_6 at Glasgow Haskell Compiler / GHC Commits: af646f1b by Matthew Pickering at 2023-03-31T10:14:30+01:00 ci: Add job to test 9.6 bootstrapping - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 572353e0644044fe3a5465bba4342a9a0b0eb60e + DOCKER_REV: ae60a90db673e679399286e3b63c21c8e7a9a9b9 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -86,6 +86,8 @@ workflow: DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_2:$DOCKER_REV" - GHC_VERSION: 9.4.3 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" + - GHC_VERSION: 9.6.1 + DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_6:$DOCKER_REV" # Allow linters to fail on draft MRs. # This must be explicitly transcluded in lint jobs which View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/af646f1be0549a4284e6674df248a256aeb400a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/af646f1be0549a4284e6674df248a256aeb400a6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 11:56:22 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 31 Mar 2023 07:56:22 -0400 Subject: [Git][ghc/ghc][wip/bootstrap-9_6] 9 commits: Add {-# WARNING #-} to Data.List.{head,tail} Message-ID: <6426ca666a3ac_3483da3891c548744125@gitlab.mail> Matthew Pickering pushed to branch wip/bootstrap-9_6 at Glasgow Haskell Compiler / GHC Commits: 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 351420ef by Matthew Pickering at 2023-03-31T12:56:13+01:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - cce1ac56 by Matthew Pickering at 2023-03-31T12:56:13+01:00 ci: Add job to test 9.6 bootstrapping - - - - - 11 changed files: - .gitlab-ci.yml - compiler/GHC/Prelude/Basic.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/ThToHs.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json - hadrian/bootstrap/plan-9_2_4.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af646f1be0549a4284e6674df248a256aeb400a6...cce1ac568a4235cc174ba7bc6e79a14ebad22e8d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af646f1be0549a4284e6674df248a256aeb400a6...cce1ac568a4235cc174ba7bc6e79a14ebad22e8d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 13:03:19 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Fri, 31 Mar 2023 09:03:19 -0400 Subject: [Git][ghc/ghc][wip/T23153] 39 commits: Allow WARNING pragmas to be controlled with custom categories Message-ID: <6426da172a54b_3483da39c25e3c766532@gitlab.mail> sheaf pushed to branch wip/T23153 at Glasgow Haskell Compiler / GHC Commits: f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 2e865058 by Simon Peyton Jones at 2023-03-31T11:22:06+01:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 7a3fb210 by Krzysztof Gogolewski at 2023-03-31T13:30:25+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - 6e8aab88 by sheaf at 2023-03-31T15:03:11+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/Env.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/FastString/Env.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Driver/Config/Diagnostic.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ab9b30ec1affe22b188f9a6637ac3bdea75bdba...6e8aab88084d63b81995430a88b787f8748f56a0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ab9b30ec1affe22b188f9a6637ac3bdea75bdba...6e8aab88084d63b81995430a88b787f8748f56a0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 13:38:51 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 31 Mar 2023 09:38:51 -0400 Subject: [Git][ghc/ghc][wip/decode_cloned_stack] Remove unnecessary instances Message-ID: <6426e26b7cd35_3483da3a7624d079571f@gitlab.mail> Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC Commits: 1f07b283 by Sven Tennie at 2023-03-31T13:37:00+00:00 Remove unnecessary instances - - - - - 2 changed files: - libraries/base/GHC/Stack/CloneStack.hs - libraries/base/cbits/StackCloningDecoding.cmm Changes: ===================================== libraries/base/GHC/Stack/CloneStack.hs ===================================== @@ -19,47 +19,29 @@ module GHC.Stack.CloneStack ( StackEntry(..), cloneMyStack, cloneThreadStack, - decode, - stackSnapshotToString + decode ) where import Control.Concurrent.MVar import Data.Maybe (catMaybes) import Foreign import GHC.Conc.Sync -import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#, Word#, unsafeCoerce#) +import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#) import GHC.IO (IO (..)) import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipLoc, ipeProv, peekInfoProv) import GHC.Stable -import GHC.Word -import Numeric -- | A frozen snapshot of the state of an execution stack. -- -- @since 4.17.0.0 data StackSnapshot = StackSnapshot !StackSnapshot# -instance Show StackSnapshot where - showsPrec _ stack rs = - "StackSnapshot(" ++ stackSnapshotToString stack ++ ")" ++ rs - -stackSnapshotToString :: StackSnapshot -> String -stackSnapshotToString (StackSnapshot s#) = pad_out (showHex addr "") - where - addr = W# (unsafeCoerce# s#) - pad_out ls = '0':'x':ls - -instance Eq StackSnapshot where - (StackSnapshot s1#) == (StackSnapshot s2#) = (W# (eqStacks# s1# s2#)) > 0 - foreign import prim "stg_decodeStackzh" decodeStack# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, Array# (Ptr InfoProvEnt) #) foreign import prim "stg_cloneMyStackzh" cloneMyStack# :: State# RealWorld -> (# State# RealWorld, StackSnapshot# #) foreign import prim "stg_sendCloneStackMessagezh" sendCloneStackMessage# :: ThreadId# -> StablePtr# PrimMVar -> State# RealWorld -> (# State# RealWorld, (# #) #) -foreign import prim "eqStackszh" eqStacks# :: StackSnapshot# -> StackSnapshot# -> Word# - {- Note [Stack Cloning] ~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/cbits/StackCloningDecoding.cmm ===================================== @@ -24,7 +24,3 @@ stg_decodeStackzh (gcptr stgStack) { return (stackEntries); } - -eqStackszh(P_ stack1, P_ stack2) { - return (stack1 == stack2); -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f07b2836603e11324171cc0b37b9b52423aca4f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f07b2836603e11324171cc0b37b9b52423aca4f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 14:47:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 31 Mar 2023 10:47:43 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 23 commits: Add {-# WARNING #-} to Data.List.{head,tail} Message-ID: <6426f28f386f4_3483da3b8115d88091b6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - f3613934 by Matthew Pickering at 2023-03-31T10:47:38-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - compiler/GHC/Prelude/Basic.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/ThToHs.hs - docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Warnings.hs - libraries/base/Control/Monad/Fix.hs - libraries/base/Data/List/NonEmpty.hs - libraries/base/GHC/List.hs - libraries/base/changelog.md - libraries/hpc - libraries/xhtml - testsuite/config/ghc - testsuite/driver/my_typing.py - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/driver/testutil.py - − testsuite/driver/typing_stubs.py - testsuite/tests/codeGen/should_compile/T3286.hs - testsuite/tests/deSugar/should_compile/ds025.hs - testsuite/tests/ghc-api/T10052/T10052.hs - testsuite/tests/ghci.debugger/scripts/T18045.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/290fd55237668fb58a005f56ce08cf655836b8af...f361393418831461e4b8949e4b7dd0bf4ae6909d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/290fd55237668fb58a005f56ce08cf655836b8af...f361393418831461e4b8949e4b7dd0bf4ae6909d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 16:00:23 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Fri, 31 Mar 2023 12:00:23 -0400 Subject: [Git][ghc/ghc][wip/T23083] 2 commits: CorePrep: Do not eliminate EmptyCase, do it in StgToCmm instead Message-ID: <6427039734d37_3483da3d10fcc4817077@gitlab.mail> Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC Commits: 9b82bdb4 by Sebastian Graf at 2023-03-31T17:48:50+02:00 CorePrep: Do not eliminate EmptyCase, do it in StgToCmm instead We eliminate EmptyCase by way of `cgCase e _ _ [] = cgExpr e` now. The main reason is that it plays far better in conjunction with eta expansion (as we aim to do for arguments in CorePrep, #23083), because we can discard any arguments, `(case e of {}) eta == case e of {}`, whereas in `(e |> co) eta` it's impossible to discard the argument. It is also both much simpler to describe than the previous mechanism of emitting an unsafe coercion and simpler to implement, removing quite a bit of commentary and the `Bool` field of `CorePrepProv`. - - - - - d0bcf370 by Sebastian Graf at 2023-03-31T17:48:50+02:00 CorePrep: Eta expand arguments (#23083) Previously, we'd only eta expand let bindings and lambdas, now we'll also eta expand arguments such as in T23083: ```hs g f h = f (h `seq` (h $)) ``` Unless `-fpedantic-bottoms` is set, we'll now transform to ```hs g f h = f (\eta -> h eta) ``` in CorePrep. See the new `Note [Eta expansion of arguments in CorePrep]` for the details. Fixes #23083. - - - - - 25 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/CoreToStg/Prep.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/CSE.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - + testsuite/tests/simplCore/should_compile/T23083.hs - + testsuite/tests/simplCore/should_compile/T23083.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -717,9 +717,11 @@ this exhaustive list can be empty! its scrutinee is (see GHC.Core.Utils.exprIsTrivial). This is actually important; see Note [Empty case is trivial] in GHC.Core.Utils -* An empty case is replaced by its scrutinee during the CoreToStg - conversion; remember STG is un-typed, so there is no need for - the empty case to do the type conversion. +* An empty case is compiled as an eval on the scrutinee in + GHC.StgToCmm.Expr.cgCase. + Historically, we lowered EmptyCase in CorePrep by way of an unsafeCoercion on + the scrutinee, but that yielded panics in CodeGen when we were beginning to + eta expand in arguments. It's simpler to stick to it until Cmm anyway. Note [Join points] ~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1390,7 +1390,7 @@ setNominalRole_maybe r co | case prov of PhantomProv _ -> False -- should always be phantom ProofIrrelProv _ -> True -- it's always safe PluginProv _ -> False -- who knows? This choice is conservative. - CorePrepProv _ -> True + CorePrepProv -> True = Just $ UnivCo prov Nominal co1 co2 setNominalRole_maybe_helper _ = Nothing @@ -1516,7 +1516,7 @@ promoteCoercion co = case co of UnivCo (PhantomProv kco) _ _ _ -> kco UnivCo (ProofIrrelProv kco) _ _ _ -> kco UnivCo (PluginProv _) _ _ _ -> mkKindCo co - UnivCo (CorePrepProv _) _ _ _ -> mkKindCo co + UnivCo CorePrepProv _ _ _ -> mkKindCo co SymCo g -> mkSymCo (promoteCoercion g) @@ -2339,7 +2339,7 @@ seqProv :: UnivCoProvenance -> () seqProv (PhantomProv co) = seqCo co seqProv (ProofIrrelProv co) = seqCo co seqProv (PluginProv _) = () -seqProv (CorePrepProv _) = () +seqProv CorePrepProv = () seqCos :: [Coercion] -> () seqCos [] = () ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -622,7 +622,7 @@ opt_univ env sym prov role oty1 oty2 #endif ProofIrrelProv kco -> ProofIrrelProv $ opt_co4_wrap env sym False Nominal kco PluginProv _ -> prov - CorePrepProv _ -> prov + CorePrepProv -> prov ------------- opt_transList :: HasDebugCallStack => InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo] ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -410,7 +410,7 @@ orphNamesOfProv :: UnivCoProvenance -> NameSet orphNamesOfProv (PhantomProv co) = orphNamesOfCo co orphNamesOfProv (ProofIrrelProv co) = orphNamesOfCo co orphNamesOfProv (PluginProv _) = emptyNameSet -orphNamesOfProv (CorePrepProv _) = emptyNameSet +orphNamesOfProv CorePrepProv = emptyNameSet orphNamesOfCos :: [Coercion] -> NameSet orphNamesOfCos = orphNamesOfThings orphNamesOfCo @@ -798,4 +798,3 @@ freeVars = go go (Type ty) = (tyCoVarsOfTypeDSet ty, AnnType ty) go (Coercion co) = (tyCoVarsOfCoDSet co, AnnCoercion co) - ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -2301,9 +2301,6 @@ lintCoercion co@(UnivCo prov r ty1 ty2) -- see #9122 for discussion of these checks checkTypes t1 t2 - | allow_ill_kinded_univ_co prov - = return () -- Skip kind checks - | otherwise = do { checkWarnL fixed_rep_1 (report "left-hand type does not have a fixed runtime representation") ; checkWarnL fixed_rep_2 @@ -2321,13 +2318,6 @@ lintCoercion co@(UnivCo prov r ty1 ty2) reps1 = typePrimRep t1 reps2 = typePrimRep t2 - -- CorePrep deliberately makes ill-kinded casts - -- e.g (case error @Int "blah" of {}) :: Int# - -- ==> (error @Int "blah") |> Unsafe Int Int# - -- See Note [Unsafe coercions] in GHC.Core.CoreToStg.Prep - allow_ill_kinded_univ_co (CorePrepProv homo_kind) = not homo_kind - allow_ill_kinded_univ_co _ = False - validateCoercion :: PrimRep -> PrimRep -> LintM () validateCoercion rep1 rep2 = do { platform <- getPlatform @@ -2357,8 +2347,8 @@ lintCoercion co@(UnivCo prov r ty1 ty2) ; check_kinds kco k1 k2 ; return (ProofIrrelProv kco') } - lint_prov _ _ prov@(PluginProv _) = return prov - lint_prov _ _ prov@(CorePrepProv _) = return prov + lint_prov _ _ prov@(PluginProv _) = return prov + lint_prov _ _ prov at CorePrepProv = return prov check_kinds kco k1 k2 = do { let Pair k1' k2' = coercionKind kco ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -240,7 +240,13 @@ ppr_expr add_par expr@(App {}) _ -> parens (hang (pprParendExpr fun) 2 pp_args) } -ppr_expr add_par (Case expr var ty [Alt con args rhs]) +ppr_expr add_par (Case expr _ ty []) -- Empty Case + = add_par $ sep [text "case" + <+> pprCoreExpr expr + <+> whenPprDebug (text "return" <+> ppr ty), + text "of {}"] + +ppr_expr add_par (Case expr var ty [Alt con args rhs]) -- Single alt Case = sdocOption sdocPrintCaseAsLet $ \case True -> add_par $ -- See Note [Print case as let] sep [ sep [ text "let! {" @@ -264,7 +270,7 @@ ppr_expr add_par (Case expr var ty [Alt con args rhs]) where ppr_bndr = pprBndr CaseBind -ppr_expr add_par (Case expr var ty alts) +ppr_expr add_par (Case expr var ty alts) -- Multi alt Case = add_par $ sep [sep [text "case" <+> pprCoreExpr expr ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -661,7 +661,7 @@ tyCoFVsOfProv :: UnivCoProvenance -> FV tyCoFVsOfProv (PhantomProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfProv (ProofIrrelProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfProv (PluginProv _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc -tyCoFVsOfProv (CorePrepProv _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc +tyCoFVsOfProv CorePrepProv fv_cand in_scope acc = emptyFV fv_cand in_scope acc tyCoFVsOfCos :: [Coercion] -> FV tyCoFVsOfCos [] fv_cand in_scope acc = emptyFV fv_cand in_scope acc @@ -731,8 +731,8 @@ almost_devoid_co_var_of_prov (PhantomProv co) cv = almost_devoid_co_var_of_co co cv almost_devoid_co_var_of_prov (ProofIrrelProv co) cv = almost_devoid_co_var_of_co co cv -almost_devoid_co_var_of_prov (PluginProv _) _ = True -almost_devoid_co_var_of_prov (CorePrepProv _) _ = True +almost_devoid_co_var_of_prov (PluginProv _) _ = True +almost_devoid_co_var_of_prov CorePrepProv _ = True almost_devoid_co_var_of_type :: Type -> CoVar -> Bool almost_devoid_co_var_of_type (TyVarTy _) _ = True @@ -1104,7 +1104,7 @@ tyConsOfType ty go_prov (PhantomProv co) = go_co co go_prov (ProofIrrelProv co) = go_co co go_prov (PluginProv _) = emptyUniqSet - go_prov (CorePrepProv _) = emptyUniqSet + go_prov CorePrepProv = emptyUniqSet -- this last case can happen from the tyConsOfType used from -- checkTauTvUpdate @@ -1318,5 +1318,4 @@ occCheckExpand vs_to_avoid ty go_prov cxt (PhantomProv co) = PhantomProv <$> go_co cxt co go_prov cxt (ProofIrrelProv co) = ProofIrrelProv <$> go_co cxt co go_prov _ p@(PluginProv _) = return p - go_prov _ p@(CorePrepProv _) = return p - + go_prov _ p at CorePrepProv = return p ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1437,9 +1437,9 @@ data UnivCoProvenance | PluginProv String -- ^ From a plugin, which asserts that this coercion -- is sound. The string is for the use of the plugin. - | CorePrepProv -- See Note [Unsafe coercions] in GHC.Core.CoreToStg.Prep - Bool -- True <=> the UnivCo must be homogeneously kinded - -- False <=> allow hetero-kinded, e.g. Int ~ Int# + | CorePrepProv -- ^ See Note [Unsafe coercions] in GHC.Core.CoreToStg.Prep + -- The UnivCo is always homogeneously kinded, e.g., it + -- disallows Int ~ Int# deriving Data.Data @@ -1447,7 +1447,7 @@ instance Outputable UnivCoProvenance where ppr (PhantomProv _) = text "(phantom)" ppr (ProofIrrelProv _) = text "(proof irrel.)" ppr (PluginProv str) = parens (text "plugin" <+> brackets (text str)) - ppr (CorePrepProv _) = text "(CorePrep)" + ppr CorePrepProv = text "(CorePrep)" -- | A coercion to be filled in by the type-checker. See Note [Coercion holes] data CoercionHole @@ -1760,7 +1760,7 @@ foldTyCo (TyCoFolder { tcf_view = view go_prov env (PhantomProv co) = go_co env co go_prov env (ProofIrrelProv co) = go_co env co go_prov _ (PluginProv _) = mempty - go_prov _ (CorePrepProv _) = mempty + go_prov _ CorePrepProv = mempty -- | A view function that looks through nothing. noView :: Type -> Maybe Type @@ -1821,7 +1821,7 @@ provSize :: UnivCoProvenance -> Int provSize (PhantomProv co) = 1 + coercionSize co provSize (ProofIrrelProv co) = 1 + coercionSize co provSize (PluginProv _) = 1 -provSize (CorePrepProv _) = 1 +provSize CorePrepProv = 1 {- ************************************************************************ ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -912,7 +912,7 @@ subst_co subst co go_prov (PhantomProv kco) = PhantomProv (go kco) go_prov (ProofIrrelProv kco) = ProofIrrelProv (go kco) go_prov p@(PluginProv _) = p - go_prov p@(CorePrepProv _) = p + go_prov p at CorePrepProv = p -- See Note [Substituting in a coercion hole] go_hole h@(CoercionHole { ch_co_var = cv }) ===================================== compiler/GHC/Core/TyCo/Tidy.hs ===================================== @@ -252,7 +252,7 @@ tidyCo env@(_, subst) co go_prov (PhantomProv co) = PhantomProv $! go co go_prov (ProofIrrelProv co) = ProofIrrelProv $! go co go_prov p@(PluginProv _) = p - go_prov p@(CorePrepProv _) = p + go_prov p at CorePrepProv = p tidyCos :: TidyEnv -> [Coercion] -> [Coercion] tidyCos env = strictMap (tidyCo env) ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -563,7 +563,7 @@ expandTypeSynonyms ty go_prov subst (PhantomProv co) = PhantomProv (go_co subst co) go_prov subst (ProofIrrelProv co) = ProofIrrelProv (go_co subst co) go_prov _ p@(PluginProv _) = p - go_prov _ p@(CorePrepProv _) = p + go_prov _ p at CorePrepProv = p -- the "False" and "const" are to accommodate the type of -- substForAllCoBndrUsing, which is general enough to @@ -981,7 +981,7 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar go_prov env (PhantomProv co) = PhantomProv <$> go_co env co go_prov env (ProofIrrelProv co) = ProofIrrelProv <$> go_co env co go_prov _ p@(PluginProv _) = return p - go_prov _ p@(CorePrepProv _) = return p + go_prov _ p at CorePrepProv = return p {- ********************************************************************* ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -321,7 +321,7 @@ toIfaceCoercionX fr co go_prov (PhantomProv co) = IfacePhantomProv (go co) go_prov (ProofIrrelProv co) = IfaceProofIrrelProv (go co) go_prov (PluginProv str) = IfacePluginProv str - go_prov (CorePrepProv b) = IfaceCorePrepProv b + go_prov CorePrepProv = IfaceCorePrepProv toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs toIfaceTcArgs = toIfaceTcArgsX emptyVarSet ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -406,7 +406,7 @@ coreToStgExpr expr@(App _ _) -- rep might not be equal to rep2 -> return (StgLit $ LitRubbish TypeLike $ getRuntimeRep (exprType expr)) - _ -> pprPanic "coreToStgExpr - Invalid app head:" (ppr expr) + _ -> pprPanic "coreToStgExpr - Invalid app head:" (ppr app_head $$ ppr expr) where (app_head, args, ticks) = myCollectArgs expr coreToStgExpr expr@(Lam _ _) ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -142,7 +142,7 @@ The goal of this pass is to prepare for code generation. profiling mode. We have to do this here because we won't have unfoldings after this pass (see `trimUnfolding` and Note [Drop unfoldings and rules]. -12. Eliminate case clutter in favour of unsafe coercions. +12. Eliminate unsafeEqualityProof in favour of unsafe coercions. See Note [Unsafe coercions] 13. Eliminate some magic Ids, specifically @@ -159,45 +159,17 @@ any trivial or useless bindings. Note [Unsafe coercions] ~~~~~~~~~~~~~~~~~~~~~~~ -CorePrep does these two transformations: - -1. Convert empty case to cast with an unsafe coercion - (case e of {}) ===> e |> unsafe-co - See Note [Empty case alternatives] in GHC.Core: if the case - alternatives are empty, the scrutinee must diverge or raise an - exception, so we can just dive into it. - - Of course, if the scrutinee *does* return, we may get a seg-fault. - A belt-and-braces approach would be to persist empty-alternative - cases to code generator, and put a return point anyway that calls a - runtime system error function. - - Notice that eliminating empty case can lead to an ill-kinded coercion - case error @Int "foo" of {} :: Int# - ===> error @Int "foo" |> unsafe-co - where unsafe-co :: Int ~ Int# - But that's fine because the expression diverges anyway. And it's - no different to what happened before. - -2. Eliminate unsafeEqualityProof in favour of an unsafe coercion - case unsafeEqualityProof of UnsafeRefl g -> e - ===> e[unsafe-co/g] - See (U2) in Note [Implementing unsafeCoerce] in base:Unsafe.Coerce - - Note that this requires us to substitute 'unsafe-co' for 'g', and - that is the main (current) reason for cpe_tyco_env in CorePrepEnv. - Tiresome, but not difficult. - -These transformations get rid of "case clutter", leaving only casts. -We are doing no further significant transformations, so the reasons -for the case forms have disappeared. And it is extremely helpful for -the ANF-ery, CoreToStg, and backends, if trivial expressions really do -look trivial. #19700 was an example. - -In both cases, the "unsafe-co" is just (UnivCo ty1 ty2 (CorePrepProv b)), -The boolean 'b' says whether the unsafe coercion is supposed to be -kind-homogeneous (yes for (2), no for (1). This information is used -/only/ by Lint. +CorePrep eliminates unsafeEqualityProof in favour of an unsafe coercion + case unsafeEqualityProof of UnsafeRefl g -> e + ===> e[unsafe-co/g] +See (U2) in Note [Implementing unsafeCoerce] in base:Unsafe.Coerce. + +The "unsafe-co" is just (UnivCo ty1 ty2 CorePrepProv), +a coercion that is always kind-homogeneous (as checked by Lint). + +Note that this requires us to substitute 'unsafe-co' for 'g', and +that is the main (current) reason for cpe_tyco_env in CorePrepEnv. +Tiresome, but not difficult. Note [CorePrep invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -830,23 +802,6 @@ cpeRhsE env expr@(Lam {}) ; body' <- cpeBodyNF env' body ; return (emptyFloats, mkLams bndrs' body') } --- Eliminate empty case --- See Note [Unsafe coercions] -cpeRhsE env (Case scrut _ ty []) - = do { (floats, scrut') <- cpeRhsE env scrut - ; let ty' = cpSubstTy env ty - scrut_ty' = exprType scrut' - co' = mkUnivCo prov Representational scrut_ty' ty' - prov = CorePrepProv False - -- False says that the kinds of two types may differ - -- E.g. we might cast Int to Int#. This is fine - -- because the scrutinee is guaranteed to diverge - - ; return (floats, Cast scrut' co') } - -- This can give rise to - -- Warning: Unsafe coercion: between unboxed and boxed value - -- but it's fine because 'scrut' diverges - -- Eliminate unsafeEqualityProof -- See Note [Unsafe coercions] cpeRhsE env (Case scrut bndr _ alts) @@ -855,8 +810,7 @@ cpeRhsE env (Case scrut bndr _ alts) -- is dead. It usually is, but see #18227 , [Alt _ [co_var] rhs] <- alts , let Pair ty1 ty2 = coVarTypes co_var - the_co = mkUnivCo prov Nominal (cpSubstTy env ty1) (cpSubstTy env ty2) - prov = CorePrepProv True -- True <=> kind homogeneous + the_co = mkUnivCo CorePrepProv Nominal (cpSubstTy env ty1) (cpSubstTy env ty2) env' = extendCoVarEnv env co_var the_co = cpeRhsE env' rhs @@ -1491,12 +1445,31 @@ cpeArg env dmd arg ; if okCpeArg arg2 then do { v <- newVar arg_ty - ; let arg3 = cpeEtaExpand (exprArity arg2) arg2 + ; let ao = cp_arityOpts (cpe_config env) + -- See Note [Eta expansion of arguments in CorePrep] + ; let arg3 | Just at <- exprEtaExpandArity ao arg2 + , not (is_join_head arg2) + -- See Note [Eta expansion for join points] + -- Eta expanding the join point would + -- introduce crap that we can't generate + -- code for + = cpeEtaExpand (arityTypeArity at) arg2 + | otherwise + = arg2 arg_float = mkFloat env dmd is_unlifted v arg3 ; return (addFloat floats2 arg_float, varToCoreExpr v) } else return (floats2, arg2) } +is_join_head :: CoreExpr -> Bool +-- ^ Identify the cases where our mishandling described in +-- Note [Eta expansion for join points] would generate crap +is_join_head (Let bs e) = isJoinBind bs || is_join_head e +is_join_head (Cast e _) = is_join_head e +is_join_head (Tick _ e) = is_join_head e +is_join_head (Case _ _ _ alts) = any is_join_head (rhssOfAlts alts) +is_join_head _ = False + {- Note [Floating unlifted arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1614,6 +1587,36 @@ and now we do NOT want eta expansion to give Instead GHC.Core.Opt.Arity.etaExpand gives f = /\a -> \y -> let s = h 3 in g s y +Note [Eta expansion of arguments in CorePrep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We eta expand arguments in here, in CorePrep, rather than in the Simplifier, and +do so based on 'exprEtaExpandArity' rather than the cheaper 'exprArity' analysis +we do on let RHSs and lambdas. The reason for the latter is that the Simplifier +has already run the more costly analysis on lambdas and let RHSs and eta +expanded accordingly, while it does not try to eta expand arguments at all. + +So why eta expand arguments in CorePrep rather than in the Simplifier? +There are two reasons why eta expansion of arguments is useful + + 1. In expressions like @f (h `seq` (g $))@ (from T23083) eta expanding the + argument to @f (\x -> h `seq` (g $ x))@ allows us to save allocation of a + closure and have a faster call sequence; a code-gen matter. + + 2. The eta expansion to @f (\x -> h `seq` (g $ x))@ gives rise to another + opportunity: We could inline ($), saving call overhead and perhaps turning + an unknown call into a known call. In general, there could be further + simplification based on the structure of the concrete argument `x`. + Whether we should inline in the PAP `(g $)` (thus solving this problem + independently of (1)) is discussed in #22886. + +To profit from (1), it is enough to eta expand in CorePrep, while (2) shows +that in some rare cases as above, eta expansion of arguments may enable +further simplification. CorePrep would not allow to exploit (2), while eta +expansion in the Simplifier would. + +Alas, trying to eta expand arguments in every round of the Simplifier is costly +(!10088 measured a geom. mean of +2.0% regression in ghc/alloc perf, regressing +as much as 27.2%), so we only exploit (1) for now. -} cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs @@ -1977,6 +1980,9 @@ data CorePrepConfig = CorePrepConfig , cp_convertNumLit :: !(LitNumType -> Integer -> Maybe CoreExpr) -- ^ Convert some numeric literals (Integer, Natural) into their final -- Core form. + + , cp_arityOpts :: !ArityOpts + -- ^ Configuration for arity analysis ('exprEtaExpandArity'). } data CorePrepEnv @@ -1987,6 +1993,7 @@ data CorePrepEnv -- enabled we instead produce an 'error' expression to catch -- the case where a function we think should bottom -- unexpectedly returns. + , cpe_env :: IdEnv CoreExpr -- Clone local Ids -- ^ This environment is used for three operations: -- ===================================== compiler/GHC/Driver/Config/CoreToStg/Prep.hs ===================================== @@ -9,6 +9,7 @@ import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) ) import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Config.Core.Lint +import GHC.Driver.Config.Core.Opt.Arity import GHC.Tc.Utils.Env import GHC.Types.Var import GHC.Utils.Outputable ( alwaysQualify ) @@ -17,14 +18,16 @@ import GHC.CoreToStg.Prep initCorePrepConfig :: HscEnv -> IO CorePrepConfig initCorePrepConfig hsc_env = do + let dflags = hsc_dflags hsc_env convertNumLit <- do - let platform = targetPlatform $ hsc_dflags hsc_env + let platform = targetPlatform dflags home_unit = hsc_home_unit hsc_env lookup_global = lookupGlobal hsc_env mkConvertNumLiteral platform home_unit lookup_global return $ CorePrepConfig { cp_catchNonexhaustiveCases = gopt Opt_CatchNonexhaustiveCases $ hsc_dflags hsc_env , cp_convertNumLit = convertNumLit + , cp_arityOpts = initArityOpts dflags } initCorePrepPgmConfig :: DynFlags -> [Var] -> CorePrepPgmConfig ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -1741,7 +1741,7 @@ freeNamesIfProv :: IfaceUnivCoProv -> NameSet freeNamesIfProv (IfacePhantomProv co) = freeNamesIfCoercion co freeNamesIfProv (IfaceProofIrrelProv co) = freeNamesIfCoercion co freeNamesIfProv (IfacePluginProv _) = emptyNameSet -freeNamesIfProv (IfaceCorePrepProv _) = emptyNameSet +freeNamesIfProv IfaceCorePrepProv = emptyNameSet freeNamesIfVarBndr :: VarBndr IfaceBndr vis -> NameSet freeNamesIfVarBndr (Bndr bndr _) = freeNamesIfBndr bndr ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -402,7 +402,7 @@ data IfaceUnivCoProv = IfacePhantomProv IfaceCoercion | IfaceProofIrrelProv IfaceCoercion | IfacePluginProv String - | IfaceCorePrepProv Bool -- See defn of CorePrepProv + | IfaceCorePrepProv -- See defn of CorePrepProv {- Note [Holes in IfaceCoercion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -624,7 +624,7 @@ substIfaceType env ty go_prov (IfacePhantomProv co) = IfacePhantomProv (go_co co) go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co) go_prov co@(IfacePluginProv _) = co - go_prov co@(IfaceCorePrepProv _) = co + go_prov co at IfaceCorePrepProv = co substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs substIfaceAppArgs env args @@ -1860,7 +1860,7 @@ pprIfaceUnivCoProv (IfaceProofIrrelProv co) = text "irrel" <+> pprParendIfaceCoercion co pprIfaceUnivCoProv (IfacePluginProv s) = text "plugin" <+> doubleQuotes (text s) -pprIfaceUnivCoProv (IfaceCorePrepProv _) +pprIfaceUnivCoProv IfaceCorePrepProv = text "CorePrep" ------------------- @@ -2229,9 +2229,8 @@ instance Binary IfaceUnivCoProv where put_ bh (IfacePluginProv a) = do putByte bh 3 put_ bh a - put_ bh (IfaceCorePrepProv a) = do + put_ bh IfaceCorePrepProv = do putByte bh 4 - put_ bh a get bh = do tag <- getByte bh @@ -2242,8 +2241,7 @@ instance Binary IfaceUnivCoProv where return $ IfaceProofIrrelProv a 3 -> do a <- get bh return $ IfacePluginProv a - 4 -> do a <- get bh - return (IfaceCorePrepProv a) + 4 -> do return IfaceCorePrepProv _ -> panic ("get IfaceUnivCoProv " ++ show tag) ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1510,7 +1510,7 @@ tcIfaceUnivCoProv :: IfaceUnivCoProv -> IfL UnivCoProvenance tcIfaceUnivCoProv (IfacePhantomProv kco) = PhantomProv <$> tcIfaceCo kco tcIfaceUnivCoProv (IfaceProofIrrelProv kco) = ProofIrrelProv <$> tcIfaceCo kco tcIfaceUnivCoProv (IfacePluginProv str) = return $ PluginProv str -tcIfaceUnivCoProv (IfaceCorePrepProv b) = return $ CorePrepProv b +tcIfaceUnivCoProv IfaceCorePrepProv = return CorePrepProv {- ************************************************************************ ===================================== compiler/GHC/Stg/CSE.hs ===================================== @@ -447,7 +447,7 @@ stgCseRhs env bndr (StgRhsClosure ext ccs upd args body) mkStgCase :: StgExpr -> OutId -> AltType -> [StgAlt] -> StgExpr -mkStgCase scrut bndr ty alts | all isBndr alts = scrut +mkStgCase scrut bndr ty alts | all isBndr alts = scrut -- NB: Always true for empty Case! | otherwise = StgCase scrut bndr ty alts where ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -53,7 +53,6 @@ import GHC.Utils.Misc import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Utils.Panic.Plain import Control.Monad ( unless, void ) import Control.Arrow ( first ) @@ -427,6 +426,8 @@ data GcPlan ------------------------------------- cgCase :: CgStgExpr -> Id -> AltType -> [CgStgAlt] -> FCode ReturnKind +cgCase e _ _ [] = cgExpr e -- See Note [Empty case alternatives] + {- Note [Scrutinising VoidRep] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1028,7 +1029,7 @@ cgIdApp fun_id args = do (text "TagCheck failed on entry in" <+> ppr mod <+> text "- value:" <> ppr fun_id <+> pdoc platform fun)) fun - EnterIt -> assert (null args) $ -- Discarding arguments + EnterIt -> assertPpr (null args) (ppr fun_id $$ ppr args) $ -- Discarding arguments emitEnter fun SlowCall -> do -- A slow function call via the RTS apply routines ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -157,7 +157,7 @@ synonymTyConsOfType ty go_prov (PhantomProv co) = go_co co go_prov (ProofIrrelProv co) = go_co co go_prov (PluginProv _) = emptyNameEnv - go_prov (CorePrepProv _) = emptyNameEnv + go_prov CorePrepProv = emptyNameEnv go_tc tc | isTypeSynonymTyCon tc = unitNameEnv (tyConName tc) tc | otherwise = emptyNameEnv ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1535,7 +1535,7 @@ collect_cand_qtvs_co orig_ty bound = go_co go_prov dv (PhantomProv co) = go_co dv co go_prov dv (ProofIrrelProv co) = go_co dv co go_prov dv (PluginProv _) = return dv - go_prov dv (CorePrepProv _) = return dv + go_prov dv CorePrepProv = return dv go_cv :: CandidatesQTvs -> CoVar -> TcM CandidatesQTvs go_cv dv@(DV { dv_cvs = cvs }) cv ===================================== testsuite/tests/simplCore/should_compile/T23083.hs ===================================== @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +module T23083 where + +g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer +g f h = f (h `seq` (h $)) ===================================== testsuite/tests/simplCore/should_compile/T23083.stderr ===================================== @@ -0,0 +1,42 @@ + +==================== CorePrep ==================== +Result size of CorePrep = {terms: 27, types: 24, coercions: 0, joins: 0/1} + +-- RHS size: {terms: 12, types: 13, coercions: 0, joins: 0/1} +T23083.g :: ((GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer) -> (GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer +[GblId, Arity=2, Str=<1C(1,L)>, Unf=OtherCon []] +T23083.g + = \ (f [Occ=Once1!] :: (GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> GHC.Num.Integer.Integer) (h [Occ=OnceL1] :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer) -> + let { + sat [Occ=Once1] :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer + [LclId] + sat = \ (eta [Occ=Once1] :: GHC.Num.Integer.Integer) -> case h of h1 [Occ=Once1] { __DEFAULT -> GHC.Base.$ @GHC.Types.LiftedRep @GHC.Num.Integer.Integer @GHC.Num.Integer.Integer h1 eta } } in + f sat + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule4 :: GHC.Prim.Addr# +[GblId, Unf=OtherCon []] +T23083.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule3 :: GHC.Types.TrName +[GblId, Unf=OtherCon []] +T23083.$trModule3 = GHC.Types.TrNameS T23083.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule2 :: GHC.Prim.Addr# +[GblId, Unf=OtherCon []] +T23083.$trModule2 = "T23083"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule1 :: GHC.Types.TrName +[GblId, Unf=OtherCon []] +T23083.$trModule1 = GHC.Types.TrNameS T23083.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T23083.$trModule :: GHC.Types.Module +[GblId, Unf=OtherCon []] +T23083.$trModule = GHC.Types.Module T23083.$trModule3 T23083.$trModule1 + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) +test('T23083', [ grep_errmsg(r'eta.+::.+Integer') ], compile, ['-O -ddump-prep -dsuppress-uniques -dppr-cols=99999']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62007593d948d3b4726f5644adf12089724f689e...d0bcf3702b2c5a701525b3a0e95ca8213e6e1d52 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62007593d948d3b4726f5644adf12089724f689e...d0bcf3702b2c5a701525b3a0e95ca8213e6e1d52 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 22:28:35 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 31 Mar 2023 18:28:35 -0400 Subject: [Git][ghc/ghc][wip/T22194-flags] Major refactor in the handling of equality constraints Message-ID: <64275e93936ca_3483da4418ca2484825d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22194-flags at Glasgow Haskell Compiler / GHC Commits: dd615d93 by Simon Peyton Jones at 2023-03-31T23:29:51+01:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 20 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd615d937a0db7747ef40562f5b3239df79356ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd615d937a0db7747ef40562f5b3239df79356ed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Mar 31 22:46:17 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 31 Mar 2023 18:46:17 -0400 Subject: [Git][ghc/ghc][wip/T13660] 2 commits: base: Add test for #13660 Message-ID: <642762b951102_3483da449a670085122e@gitlab.mail> Ben Gamari pushed to branch wip/T13660 at Glasgow Haskell Compiler / GHC Commits: 3ebaff02 by Ben Gamari at 2023-03-25T23:39:39-04:00 base: Add test for #13660 - - - - - a6d1b763 by Ben Gamari at 2023-03-31T18:46:08-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 3 changed files: - libraries/base/System/Posix/Internals.hs - + libraries/base/tests/T13660.hs - libraries/base/tests/all.T Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -43,6 +43,8 @@ import System.IO.Error import GHC.Base import GHC.Num +import GHC.OldList (elem) +import GHC.Ptr import GHC.Real import GHC.IO import GHC.IO.IOMode @@ -164,13 +166,22 @@ fdGetMode fd = do #if defined(mingw32_HOST_OS) withFilePath :: FilePath -> (CWString -> IO a) -> IO a -withFilePath = withCWString +withFilePath fp f = do + checkForInteriorNuls fp + withCWString fp f newFilePath :: FilePath -> IO CWString -newFilePath = newCWString +newFilePath fp = do + checkForInteriorNuls fp + newCWString fp peekFilePath :: CWString -> IO FilePath peekFilePath = peekCWString + +-- | Check a 'FilePath' for internal NUL codepoints as these are +-- disallowed in Windows filepaths. See #13660. +checkForInteriorNuls :: FilePath -> IO () +checkForInteriorNuls fp = when ('\0' `elem` fp) (throwInternalNulError fp) #else withFilePath :: FilePath -> (CString -> IO a) -> IO a @@ -178,13 +189,43 @@ newFilePath :: FilePath -> IO CString peekFilePath :: CString -> IO FilePath peekFilePathLen :: CStringLen -> IO FilePath -withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f -newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp +withFilePath fp f = do + enc <- getFileSystemEncoding + GHC.withCStringLen enc fp $ \(str, len) -> do + checkForInteriorNuls fp (str, len) + f str +newFilePath fp = do + enc <- getFileSystemEncoding + (str, len) <- GHC.newCStringLen enc fp + checkForInteriorNuls fp (str, len) + return str peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp +-- | Check an encoded 'FilePath' for internal NUL octets as these are +-- disallowed in POSIX filepaths. See #13660. +checkForInteriorNuls :: FilePath -> CStringLen -> IO () +checkForInteriorNuls fp (str, len) = + when (len' /= len) (throwInternalNulError fp) + -- N.B. If the string contains internal NUL codeunits then the strlen will + -- indicate a size smaller than that returned by withCStringLen. + where + len' = case str of Ptr ptr -> I# (cstringLength# ptr) #endif +throwInternalNulError :: FilePath -> IO a +throwInternalNulError fp = ioError err + where + err = + IOError + { ioe_handle = Nothing + , ioe_type = InvalidArgument + , ioe_location = "checkForInteriorNuls" + , ioe_description = "FilePaths must not contain internal NUL code units." + , ioe_errno = Nothing + , ioe_filename = Just fp + } + -- --------------------------------------------------------------------------- -- Terminal-related stuff ===================================== libraries/base/tests/T13660.hs ===================================== @@ -0,0 +1,9 @@ +-- | This should print an InvalidArgument error complaining that +-- the file path contains a NUL octet. +module Main where + +main :: IO () +main = do + catchIOError + (writeFile "hello\x00world" "hello") + print ===================================== libraries/base/tests/all.T ===================================== @@ -256,6 +256,7 @@ test('T13191', ['-O']) test('T13525', [when(opsys('mingw32'), skip), js_broken(22374)], compile_and_run, ['']) test('T13097', normal, compile_and_run, ['']) +test('T13660', when(opsys('mingw32'), skip), compile_and_run, ['']) test('functorOperators', normal, compile_and_run, ['']) test('T3474', [collect_stats('max_bytes_used',5), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6625b5fc91b4771971826b4bc245a24e7fc2b245...a6d1b763cba5049c3448eabc3703fec4a1a3f08b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6625b5fc91b4771971826b4bc245a24e7fc2b245...a6d1b763cba5049c3448eabc3703fec4a1a3f08b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: